Annotation of OpenXM_contrib/PHC/Ada/Continuation/increment_and_fix_continuation.adb, Revision 1.1.1.1
1.1 maekawa 1: with integer_io; use integer_io;
2: with Standard_Floating_Numbers_io; use Standard_Floating_Numbers_io;
3: with Standard_Complex_Numbers_io; use Standard_Complex_Numbers_io;
4: with Standard_Complex_Solutions_io; use Standard_Complex_Solutions_io;
5: with Path_Trackers; use Path_Trackers;
6: with Continuation_Parameters; use Continuation_Parameters;
7: with Continuation_Data; use Continuation_Data;
8:
9: package body Increment_and_Fix_Continuation is
10:
11: -- AUXILIAIRIES :
12:
13: function At_Infinity ( s : Solution; proj : boolean ) return boolean is
14:
15: -- DESCRIPTION :
16: -- Decides whether a given solution lies at infinity.
17:
18: begin
19: if proj
20: then if AbsVal(s.v(s.v'last)) < 1.0/tol_endg_at_infinity
21: then return true;
22: else return false;
23: end if;
24: else for i in 1..s.n loop
25: if AbsVal(s.v(i)) > tol_endg_at_infinity
26: then return true;
27: end if;
28: end loop;
29: return false;
30: end if;
31: end At_Infinity;
32:
33: function Equals ( s : in Solu_Info_Array; x : in Vector; i : in natural;
34: d : in double_float; proj : in boolean ) return natural is
35:
36: -- DESCRIPTION :
37: -- Returns the index j in the solution array s(s'first..i) of the
38: -- solution which equals x.
39:
40: eq : boolean := false;
41: j : natural := s'first;
42:
43: begin
44: while j < i loop
45: if not At_Infinity(s(j).sol.all,proj)
46: then eq := true;
47: if proj
48: then for k in x'range loop
49: if AbsVal(s(j).sol.v(k)/s(j).sol.v(x'last)
50: - x(k)/x(x'last)) > d
51: then eq := false; exit;
52: end if;
53: end loop;
54: else for k in x'range loop
55: if AbsVal(s(j).sol.v(k) - x(k)) > d
56: then eq := false; exit;
57: end if;
58: end loop;
59: end if;
60: end if;
61: exit when eq;
62: j := j + 1;
63: end loop;
64: return j;
65: end Equals;
66:
67: procedure Add_Clustered ( i,n : in natural; sols : in Solution_List;
68: clusols : in out Solution_List ) is
69:
70: -- DESCRIPTION :
71: -- Adds the ith start solution to the list clusols.
72: -- The multiplicity of the solution equals i.
73:
74: s : Solution(n) := Get(sols,i);
75: tol : constant double_float := 10.0**(-12);
76:
77: begin
78: if not Is_In(clusols,s,tol)
79: then s.m := i;
80: Add(clusols,s);
81: end if;
82: end Add_Clustered;
83:
84: procedure Write_Bar ( file : in file_type ) is
85: begin
86: put(file,"========================================");
87: put_line(file,"===================================");
88: end Write_Bar;
89:
90: procedure Write_Statistics ( file : in file_type;
91: i,nstep,nfail,niter,nsyst : in natural ) is
92:
93: -- DESCRIPTION :
94: -- Writes the computing statistics of the ith path on file.
95:
96: begin
97: put(file,"== "); put(file,i,1); put(file," = ");
98: put(file," #step : "); put(file,nstep,3);
99: put(file," #fail : "); put(file,nfail,2);
100: put(file," #iter : "); put(file,niter,3);
101: if nsyst /= niter
102: then put(file," #syst : "); put(file,nsyst,3);
103: end if;
104: put(file," = ");
105: end Write_Statistics;
106:
107: procedure Write_Diagnostics
108: ( file : in file_type; s : in out Solu_Info_Array;
109: c : in Corr_Pars; tol : in double_float; i : in natural;
110: proj : in boolean;
111: ninfi,nregu,nsing,nclus,nfail : in out natural;
112: sols : in Solution_List; clusols : in out Solution_List ) is
113:
114: -- DESCRIPTION :
115: -- Writes the diagnostics for the ith solution.
116: -- If it is a clustered solution, then the corresponding start solution
117: -- will be added from the list sols to the list clusols.
118:
119: j : natural;
120:
121: begin
122: if At_Infinity(s(i).sol.all,proj)
123: then ninfi := ninfi + 1;
124: put_line(file,"at infinity ==");
125: elsif ((s(i).cora <= c.epsax) or else (s(i).resa <= c.epsaf)
126: or else (s(i).corr <= c.epsrx) or else (s(i).resr <= c.epsrf))
127: then j := Equals(s,s(i).sol.v,i,tol,proj);
128: if j = i
129: then if s(i).rcond > tol_endg_inverse_condition
130: then nregu := nregu + 1;
131: put_line(file,"regular solution ==");
132: else nsing := nsing + 1;
133: put_line(file,"singular solution ==");
134: end if;
135: elsif s(i).rcond < tol_endg_inverse_condition
136: then nsing := nsing + 1;
137: s(j).sol.m := s(j).sol.m + 1;
138: s(i).sol.m := s(i).sol.m + 1;
139: put(file,"multiple, see ");
140: put(file,j,1); put_line(file," ==");
141: else nclus := nclus + 1;
142: put(file,"clustered with ");
143: put(file,j,1); put_line(file," ==");
144: Add_Clustered(i,s(i).sol.n,sols,clusols);
145: Add_Clustered(j,s(j).sol.n,sols,clusols);
146: end if;
147: elsif s(i).rcond < tol_endg_inverse_condition
148: then nfail := nfail + 1;
149: put_line(file,"failure ==");
150: else nfail := nfail + 1;
151: put_line(file,"failure ==");
152: end if;
153: end Write_Diagnostics;
154:
155: procedure Write_Solution ( file : in file_type; s : in Solu_Info ) is
156:
157: -- DESCRIPTION :
158: -- Writes the solution and the length of the path on file.
159:
160: begin
161: put(file,"t : "); put(file,s.sol.t); new_line(file);
162: put(file,"m : "); put(file,s.sol.m,1);
163: put(file," Length of path : ");
164: put(file,s.length_path);
165: new_line(file);
166: put_line(file,"the solution for t : ");
167: put_vector(file,s.sol.all);
168: put(file,"==");
169: put(file," err : "); put(file,s.cora,2,3,3); put(file," =");
170: put(file," rco : "); put(file,s.rcond,2,3,3); put(file," =");
171: put(file," res : "); put(file,s.resa,2,3,3); put_line(file," ==");
172: end Write_Solution;
173:
174: procedure Diagnostics
175: ( s : in out Solu_Info_Array; c : in Corr_Pars;
176: tol : in double_float;i : in natural; proj : in boolean;
177: ninfi,nregu,nsing,nclus,nfail : in out natural;
178: sols : in Solution_List; clusols : in out Solution_List ) is
179:
180: -- DESCRIPTION :
181: -- Analyzes the ith solution. If it is a clustered solution, then the
182: -- corresponding start solution from the list sols will be added to the
183: -- list clusols.
184:
185: j : natural;
186:
187: begin
188: if At_Infinity(s(i).sol.all,proj)
189: then ninfi := ninfi + 1;
190: elsif ((s(i).cora <= c.epsax) or else (s(i).resa <= c.epsaf)
191: or else (s(i).corr <= c.epsrx) or else (s(i).resr <= c.epsrf))
192: then j := Equals(s,s(i).sol.v,i,tol,proj);
193: if j = i
194: then if s(i).rcond > tol_endg_inverse_condition
195: then nregu := nregu + 1;
196: else nsing := nsing + 1;
197: end if;
198: elsif s(i).rcond < tol_endg_inverse_condition
199: then nsing := nsing + 1;
200: s(j).sol.m := s(j).sol.m + 1;
201: s(i).sol.m := s(i).sol.m + 1;
202: else nclus := nclus + 1;
203: Add_Clustered(i,s(i).sol.n,sols,clusols);
204: Add_Clustered(j,s(j).sol.n,sols,clusols);
205: end if;
206: elsif s(i).rcond < tol_endg_inverse_condition
207: then nfail := nfail + 1;
208: else nfail := nfail + 1;
209: end if;
210: end Diagnostics;
211:
212: procedure Write_Summary_Diagnostics
213: ( file : in file_type;
214: ninfi,nregu,nsing,nfail,nclus : in natural ) is
215:
216: -- DESCRIPTION :
217: -- Writes a summary after the continuation.
218:
219: begin
220: put(file,"== ");
221: put(file,"#regu : "); put(file,nregu,1); put(file," = " );
222: put(file,"#sing : "); put(file,nsing,1); put(file," = " );
223: put(file,"#clus : "); put(file,nclus,1); put(file," = " );
224: put(file,"#infi : "); put(file,ninfi,1); put(file," = " );
225: put(file,"#fail : "); put(file,nfail,1);
226: put_line(file," == " );
227: end Write_Summary_Diagnostics;
228:
229: procedure Merge_Clustered
230: ( s : in out Solu_Info_Array; clusols : in Solution_List ) is
231:
232: -- DESCRIPTION :
233: -- The new solutions, which were clustered before, are merged with
234: -- the solution array, by using there multiplicity.
235:
236: tmp : Solution_List := clusols;
237: ls : Link_to_Solution;
238:
239: begin
240: while not Is_Null(tmp) loop
241: ls := Head_Of(tmp);
242: s(ls.m).sol := new Solution'(ls.all);
243: tmp := Tail_Of(tmp);
244: end loop;
245: end Merge_Clustered;
246:
247: -- TARGET ROUTINES :
248:
249: procedure Silent_Continue
250: ( sols : in out Solution_List; proj : in boolean;
251: target : in Complex_Number := Create(1.0) ) is
252:
253: sia : Solu_Info_Array(1..Length_Of(sols)) := Deep_Create(sols);
254: ppa,pen : Pred_Pars;
255: cpa,cen : Corr_Pars;
256: tol : constant double_float := 10.0**(-10);
257: dumv : Standard_Floating_Vectors.Link_to_Vector;
258: err : double_float;
259:
260: procedure LCont1 is
261: new Linear_Single_Normal_Silent_Continue(Norm,H,dH,dH);
262: procedure LCont2 is
263: new Linear_Single_Conditioned_Silent_Continue(Norm,H,dH,dH);
264: procedure LContN1 is
265: new Linear_Multiple_Normal_Silent_Continue(Norm,H,dH,dH);
266:
267: procedure Rerun_Clustered
268: ( s : in out Solu_Info_Array;
269: clusols : in out Solution_List ) is
270:
271: oldmax : natural := max_reruns;
272: oldblk : natural := block_size;
273:
274: begin
275: condition := condition + 1;
276: Continuation_Parameters.Tune(condition);
277: max_reruns := oldmax - 1;
278: block_size := Length_Of(clusols);
279: Silent_Continue(clusols,proj,target);
280: block_size := oldblk;
281: Merge_Clustered(s,clusols);
282: Deep_Clear(clusols);
283: end Rerun_Clustered;
284:
285: procedure Sequential_Continue
286: ( s : in out Solu_Info_Array;
287: target : in Complex_Number; tol : in double_float;
288: p1,p2 : in Pred_Pars; c_path,c_end : in Corr_Pars ) is
289:
290: ninfi,nregu,nsing,nfail,nclus : natural := 0;
291: clusols : Solution_List;
292:
293: begin
294: for i in s'range loop
295: LCont1(s(i),target,tol,proj,p1,c_path);
296: LCont2(s(i),target,tol,proj,0,dumv,err,p2,c_end);
297: Diagnostics(s,c_end,tol,i,proj,
298: ninfi,nregu,nsing,nclus,nfail,sols,clusols);
299: end loop;
300: if (nclus > 0) and then (max_reruns > 0)
301: then Rerun_Clustered(s,clusols);
302: end if;
303: end Sequential_Continue;
304:
305: procedure Continue_End_Game
306: ( s : in out Solu_Info_Array;
307: target : in Complex_Number; tol : in double_float;
308: p : in Pred_Pars; c : in Corr_Pars ) is
309:
310: -- DESCRIPTION :
311: -- End game for the simultaneous path following.
312:
313: ninfi,nregu,nsing,nfail,nclus : natural := 0;
314: clusols : Solution_List;
315:
316: begin
317: for i in s'range loop
318: LCont2(s(i),target,tol,proj,0,dumv,err,p,c);
319: end loop;
320: for i in s'range loop
321: Diagnostics(s,c,tol,i,proj,ninfi,nregu,nsing,nclus,nfail,sols,clusols);
322: end loop;
323: if (nclus > 0) and then (max_reruns > 0)
324: then Rerun_Clustered(s,clusols);
325: end if;
326: end Continue_end_Game;
327:
328: procedure Parallel_Continue
329: ( s : in out Solu_Info_Array;
330: target : in Complex_Number; tol : in double_float;
331: p_path,p_end : in Pred_Pars; c_path,c_end : in Corr_Pars ) is
332:
333: -- DESCRIPTION :
334: -- This procedure implements the simultaneous continuation of
335: -- different solution paths.
336:
337: ninfi,nregu,nsing,nfail,nclus : natural := 0;
338: nb,index : natural;
339: blck : natural := block_size;
340:
341: begin
342: nb := 1; index := 0;
343: while index < s'last loop
344: if blck > s'last - index
345: then blck := s'last - index;
346: end if;
347: declare
348: sbk : Solu_Info_Array(1..blck) := s(index+1..index+blck);
349: begin
350: LContN1(sbk,target,tol,tol_path_distance,proj,p_path,c_path);
351: Continue_end_Game(sbk,target,tol,p_end,c_end);
352: s(index+1..index+blck) := sbk;
353: end;
354: nb := nb + 1;
355: index := index + blck;
356: end loop;
357: end Parallel_Continue;
358:
359: begin
360: ppa := Continuation_Parameters.Create_for_Path;
361: pen := Continuation_Parameters.Create_End_Game;
362: cpa := Continuation_Parameters.Create_for_Path;
363: cen := Continuation_Parameters.Create_End_Game;
364: if block_size = 1
365: then Sequential_Continue(sia,target,tol,ppa,pen,cpa,cen);
366: else Parallel_Continue(sia,target,tol,ppa,pen,cpa,cen);
367: end if;
368: Deep_Clear(sols);
369: sols := Shallow_Create(sia);
370: end Silent_Continue;
371:
372: procedure Reporting_Continue
373: ( file : in file_type; sols : in out Solution_List;
374: proj : in boolean;
375: target : in Complex_Number := Create(1.0) ) is
376:
377: sia : Solu_Info_Array(1..Length_Of(sols)) := Deep_Create(sols);
378: ppa,pen : Pred_Pars;
379: cpa,cen : Corr_Pars;
380: tol : constant double_float := 10.0**(-10);
381: dumv : Standard_Floating_Vectors.Link_to_Vector;
382: err : double_float;
383:
384: procedure LCont1 is
385: new Linear_Single_Normal_Reporting_Continue(Norm,H,dH,dH);
386: procedure LCont2 is
387: new Linear_Single_Conditioned_Reporting_Continue(Norm,H,dH,dH);
388: procedure LContN1 is
389: new Linear_Multiple_Normal_Reporting_Continue(Norm,H,dH,dH);
390: procedure CCont2 is
391: new Circular_Single_Conditioned_Reporting_Continue(Norm,H,dH,dH);
392:
393: procedure Rerun_Clustered
394: ( file : in file_type; s : in out Solu_Info_Array;
395: clusols : in out Solution_List ) is
396:
397: oldmax : natural := max_reruns;
398: oldblk : natural := block_size;
399:
400: begin
401: condition := condition + 1;
402: Continuation_Parameters.Tune(condition);
403: max_reruns := oldmax - 1;
404: block_size := Length_Of(clusols);
405: Reporting_Continue(file,clusols,proj,target);
406: block_size := oldblk;
407: Merge_Clustered(s,clusols);
408: Deep_Clear(clusols);
409: end Rerun_Clustered;
410:
411: procedure Sequential_Continue
412: ( file : in file_type; s : in out Solu_Info_Array;
413: target : in Complex_Number; tol : in double_float;
414: p1,p2 : in Pred_Pars; c_path,c_end : in Corr_Pars ) is
415:
416: ninfi,nregu,nsing,nfail,nclus : natural := 0;
417: clusols : Solution_List;
418:
419: begin
420: Write_Bar(file);
421: for i in s'range loop
422: LCont1(file,s(i),target,tol,proj,p1,c_path);
423: LCont2(file,s(i),target,tol,proj,0,dumv,err,p2,c_end);
424: Write_Statistics(file,i,s(i).nstep,s(i).nfail,s(i).niter,s(i).nsyst);
425: Write_Diagnostics(file,s,c_end,tol,i,proj,
426: ninfi,nregu,nsing,nclus,nfail,sols,clusols);
427: Write_Solution(file,s(i));
428: end loop;
429: Write_Summary_Diagnostics(file,ninfi,nregu,nsing,nfail,nclus);
430: if (nclus > 0) and then (max_reruns > 0)
431: then Rerun_Clustered(file,s,clusols);
432: end if;
433: end Sequential_Continue;
434:
435: procedure Continue_End_Game
436: ( file : in file_type; s : in out Solu_Info_Array;
437: target : in Complex_Number; tol : in double_float;
438: p : in Pred_Pars; c : in Corr_Pars ) is
439:
440: ninfi,nregu,nsing,nfail,nclus : natural := 0;
441: clusols : Solution_List;
442:
443: begin
444: for i in s'range loop
445: LCont2(file,s(i),target,tol,proj,0,dumv,err,p,c);
446: end loop;
447: Write_Bar(file);
448: for i in s'range loop
449: Write_Statistics(file,i,s(i).nstep,s(i).nfail,s(i).niter,s(i).nsyst);
450: Write_Diagnostics(file,s,c,tol,i,proj,
451: ninfi,nregu,nsing,nclus,nfail,sols,clusols);
452: Write_Solution(file,s(i));
453: end loop;
454: put_line(file,"The computed solutions :");
455: declare
456: solus : Solution_List := Deep_Create(s);
457: begin
458: put(file,solus); Deep_Clear(solus);
459: end;
460: Write_Summary_Diagnostics(file,ninfi,nregu,nsing,nfail,nclus);
461: if (nclus > 0) and then (max_reruns > 0)
462: then Rerun_Clustered(file,s,clusols);
463: end if;
464: end Continue_end_Game;
465:
466: procedure Parallel_Continue
467: ( file : in file_type; s : in out Solu_Info_Array;
468: target : in Complex_Number; tol : in double_float;
469: p_path,p_end : in Pred_Pars; c_path,c_end : in Corr_Pars ) is
470:
471: -- DESCRIPTION :
472: -- This procedure implements the simultaneous continuation of
473: -- different solution paths.
474:
475: ninfi,nregu,nsing,nfail,nclus : natural := 0;
476: nb,index : natural;
477: blck : natural := block_size;
478:
479: begin
480: nb := 1; index := 0;
481: while index < s'last loop
482: if blck > s'last - index
483: then blck := s'last - index;
484: end if;
485: declare
486: sbk : Solu_Info_Array(1..blck) := s(index+1..index+blck);
487: begin
488: LContN1(file,sbk,target,tol,tol_path_distance,proj,p_path,c_path);
489: Continue_end_Game(file,sbk,target,tol,p_end,c_end);
490: s(index+1..index+blck) := sbk;
491: end;
492: nb := nb + 1;
493: index := index + blck;
494: end loop;
495: end Parallel_Continue;
496:
497: begin
498: ppa := Continuation_Parameters.Create_for_Path;
499: pen := Continuation_Parameters.Create_End_Game;
500: cpa := Continuation_Parameters.Create_for_Path;
501: cen := Continuation_Parameters.Create_End_Game;
502: if block_size = 1
503: then Sequential_Continue(file,sia,target,tol,ppa,pen,cpa,cen);
504: else Parallel_Continue(file,sia,target,tol,ppa,pen,cpa,cen);
505: end if;
506: Deep_Clear(sols);
507: sols := Shallow_Create(sia);
508: end Reporting_Continue;
509:
510: -- CONTINUATION WITH ESTIMATION OF PATH DIRECTIONS :
511:
512: procedure Silent_Toric_Continue
513: ( sols : in out Solution_List; proj : in boolean;
514: v : in out VecVec;
515: errv : in out Standard_Floating_Vectors.Vector;
516: target : in Complex_Number := Create(1.0) ) is
517:
518: rtoric : natural := Continuation_Parameters.endext_order;
519: sia : Solu_Info_Array(1..Length_Of(sols)) := Deep_Create(sols);
520: ppa,pen : Pred_Pars;
521: cpa,cen : Corr_Pars;
522: tol : constant double_float := 10.0**(-10);
523:
524: procedure LCont1 is
525: new Linear_Single_Normal_Silent_Continue(Norm,H,dH,dH);
526: procedure LCont2 is
527: new Linear_Single_Conditioned_Silent_Continue(Norm,H,dH,dH);
528: procedure LContN1 is
529: new Linear_Multiple_Normal_Silent_Continue(Norm,H,dH,dH);
530:
531: procedure Rerun_Clustered
532: ( s : in out Solu_Info_Array;
533: clusols : in out Solution_List ) is
534:
535: oldmax : natural := max_reruns;
536: oldblk : natural := block_size;
537:
538: begin
539: condition := condition + 1;
540: Continuation_Parameters.Tune(condition);
541: max_reruns := oldmax - 1;
542: block_size := Length_Of(clusols);
543: Silent_Toric_Continue(clusols,proj,v,errv,target);
544: block_size := oldblk;
545: Merge_Clustered(s,clusols);
546: Deep_Clear(clusols);
547: end Rerun_Clustered;
548:
549: procedure Sequential_Continue
550: ( s : in out Solu_Info_Array;
551: target : in Complex_Number; tol : in double_float;
552: p1,p2 : in Pred_Pars; c_path,c_end : in Corr_Pars ) is
553:
554: ninfi,nregu,nsing,nfail,nclus : natural := 0;
555: clusols : Solution_List;
556:
557: begin
558: for i in s'range loop
559: LCont1(s(i),target,tol,proj,p1,c_path);
560: LCont2(s(i),target,tol,proj,rtoric,v(i),errv(i),p2,c_end);
561: Diagnostics(s,c_end,tol,i,proj,
562: ninfi,nregu,nsing,nclus,nfail,sols,clusols);
563: end loop;
564: if (nclus > 0) and then (max_reruns > 0)
565: then Rerun_Clustered(s,clusols);
566: end if;
567: end Sequential_Continue;
568:
569: procedure Continue_End_Game
570: ( s : in out Solu_Info_Array;
571: target : in Complex_Number; tol : in double_float;
572: p : in Pred_Pars; c : in Corr_Pars ) is
573:
574: ninfi,nregu,nsing,nfail,nclus : natural := 0;
575: clusols : Solution_List;
576:
577: begin
578: for i in s'range loop
579: LCont2(s(i),target,tol,proj,rtoric,v(i),errv(i),p,c);
580: end loop;
581: for i in s'range loop
582: Diagnostics(s,c,tol,i,proj,ninfi,nregu,nsing,nclus,nfail,sols,clusols);
583: end loop;
584: if (nclus > 0) and then (max_reruns > 0)
585: then Rerun_Clustered(s,clusols);
586: end if;
587: end Continue_end_Game;
588:
589: procedure Parallel_Continue
590: ( s : in out Solu_Info_Array;
591: target : in Complex_Number; tol : in double_float;
592: p_path,p_end : in Pred_Pars; c_path,c_end : in Corr_Pars ) is
593:
594: -- DESCRIPTION :
595: -- This procedure implements the simultaneous continuation of
596: -- different solution paths.
597:
598: ninfi,nregu,nsing,nfail,nclus : natural := 0;
599: nb,index : natural;
600: blck : natural := block_size;
601:
602: begin
603: nb := 1; index := 0;
604: while index < s'last loop
605: if blck > s'last - index
606: then blck := s'last - index;
607: end if;
608: declare
609: sbk : Solu_Info_Array(1..blck) := s(index+1..index+blck);
610: begin
611: LContN1(sbk,target,tol,tol_path_distance,proj,p_path,c_path);
612: Continue_end_Game(sbk,target,tol,p_end,c_end);
613: s(index+1..index+blck) := sbk;
614: end;
615: nb := nb + 1;
616: index := index + blck;
617: end loop;
618: end Parallel_Continue;
619:
620: begin
621: ppa := Continuation_Parameters.Create_for_Path;
622: pen := Continuation_Parameters.Create_End_Game;
623: cpa := Continuation_Parameters.Create_for_Path;
624: cen := Continuation_Parameters.Create_End_Game;
625: if block_size = 1
626: then Sequential_Continue(sia,target,tol,ppa,pen,cpa,cen);
627: else Parallel_Continue(sia,target,tol,ppa,pen,cpa,cen);
628: end if;
629: Deep_Clear(sols);
630: sols := Shallow_Create(sia);
631: end Silent_Toric_Continue;
632:
633: procedure Reporting_Toric_Continue
634: ( file : in file_type; sols : in out Solution_List;
635: proj : in boolean; v : in out VecVec;
636: errv : in out Standard_Floating_Vectors.Vector;
637: target : in Complex_Number := Create(1.0) ) is
638:
639: rtoric : natural := Continuation_Parameters.endext_order;
640: sia : Solu_Info_Array(1..Length_Of(sols)) := Deep_Create(sols);
641: ppa,pen : Pred_Pars;
642: cpa,cen : Corr_Pars;
643: tol : constant double_float := 10.0**(-10);
644:
645: procedure LCont1 is
646: new Linear_Single_Normal_Reporting_Continue(Norm,H,dH,dH);
647: procedure LCont2 is
648: new Linear_Single_Conditioned_Reporting_Continue(Norm,H,dH,dH);
649: procedure LContN1 is
650: new Linear_Multiple_Normal_Reporting_Continue(Norm,H,dH,dH);
651: procedure CCont2 is
652: new Circular_Single_Conditioned_Reporting_Continue(Norm,H,dH,dH);
653:
654: procedure Rerun_Clustered
655: ( file : in file_type; s : in out Solu_Info_Array;
656: clusols : in out Solution_List ) is
657:
658: oldmax : natural := max_reruns;
659: oldblk : natural := block_size;
660:
661: begin
662: condition := condition + 1;
663: Continuation_Parameters.Tune(condition);
664: max_reruns := oldmax - 1;
665: block_size := Length_Of(clusols);
666: Reporting_Toric_Continue(file,clusols,proj,v,errv,target);
667: block_size := oldblk;
668: Merge_Clustered(s,clusols);
669: Deep_Clear(clusols);
670: end Rerun_Clustered;
671:
672: procedure Sequential_Continue
673: ( file : in file_type; s : in out Solu_Info_Array;
674: target : in Complex_Number; tol : in double_float;
675: p1,p2 : in Pred_Pars; c_path,c_end : in Corr_Pars ) is
676:
677: ninfi,nregu,nsing,nfail,nclus : natural := 0;
678: clusols : Solution_List;
679:
680: begin
681: Write_Bar(file);
682: for i in s'range loop
683: LCont1(file,s(i),target,tol,proj,p1,c_path);
684: LCont2(file,s(i),target,tol,proj,rtoric,v(i),errv(i),p2,c_end);
685: Write_Statistics(file,i,s(i).nstep,s(i).nfail,s(i).niter,s(i).nsyst);
686: Write_Diagnostics(file,s,c_end,tol,i,proj,
687: ninfi,nregu,nsing,nclus,nfail,sols,clusols);
688: Write_Solution(file,s(i));
689: end loop;
690: Write_Summary_Diagnostics(file,ninfi,nregu,nsing,nfail,nclus);
691: if (nclus > 0) and then (max_reruns > 0)
692: then Rerun_Clustered(file,s,clusols);
693: end if;
694: end Sequential_Continue;
695:
696: procedure Continue_End_Game
697: ( file : in file_type; s : in out Solu_Info_Array;
698: target : in Complex_Number; tol : in double_float;
699: p : in Pred_Pars; c : in Corr_Pars ) is
700:
701: ninfi,nregu,nsing,nfail,nclus : natural := 0;
702: clusols : Solution_List;
703:
704: begin
705: for i in s'range loop
706: LCont2(file,s(i),target,tol,proj,rtoric,v(i),errv(i),p,c);
707: end loop;
708: Write_Bar(file);
709: for i in s'range loop
710: Write_Statistics(file,i,s(i).nstep,s(i).nfail,s(i).niter,s(i).nsyst);
711: Write_Diagnostics(file,s,c,tol,i,proj,
712: ninfi,nregu,nsing,nclus,nfail,sols,clusols);
713: Write_Solution(file,s(i));
714: end loop;
715: put_line(file,"The computed solutions :");
716: declare
717: solus : Solution_List := Deep_Create(s);
718: begin
719: put(file,solus); Deep_Clear(solus);
720: end;
721: Write_Summary_Diagnostics(file,ninfi,nregu,nsing,nfail,nclus);
722: if (nclus > 0) and then (max_reruns > 0)
723: then Rerun_Clustered(file,s,clusols);
724: end if;
725: end Continue_end_Game;
726:
727: procedure Parallel_Continue
728: ( file : in file_type; s : in out Solu_Info_Array;
729: target : in Complex_Number; tol : in double_float;
730: p_path,p_end : in Pred_Pars; c_path,c_end : in Corr_Pars ) is
731:
732: -- DESCRIPTION :
733: -- This procedure implements the simultaneous continuation of
734: -- different solution paths.
735:
736: ninfi,nregu,nsing,nfail,nclus : natural := 0;
737: nb,index : natural;
738: blck : natural := block_size;
739:
740: begin
741: nb := 1; index := 0;
742: while index < s'last loop
743: if blck > s'last - index
744: then blck := s'last - index;
745: end if;
746: declare
747: sbk : Solu_Info_Array(1..blck) := s(index+1..index+blck);
748: begin
749: LContN1(file,sbk,target,tol,tol_path_distance,proj,p_path,c_path);
750: Continue_end_Game(file,sbk,target,tol,p_end,c_end);
751: s(index+1..index+blck) := sbk;
752: end;
753: nb := nb + 1;
754: index := index + blck;
755: end loop;
756: end Parallel_Continue;
757:
758: begin
759: ppa := Continuation_Parameters.Create_for_Path;
760: pen := Continuation_Parameters.Create_End_Game;
761: cpa := Continuation_Parameters.Create_for_Path;
762: cen := Continuation_Parameters.Create_End_Game;
763: if block_size = 1
764: then Sequential_Continue(file,sia,target,tol,ppa,pen,cpa,cen);
765: else Parallel_Continue(file,sia,target,tol,ppa,pen,cpa,cen);
766: end if;
767: Deep_Clear(sols);
768: sols := Shallow_Create(sia);
769: end Reporting_Toric_Continue;
770:
771: end Increment_and_Fix_Continuation;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to increment_and_fix_continuation.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Continuation