Annotation of OpenXM_contrib/PHC/Ada/Continuation/increment_and_fix_continuation.adb, Revision 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