eigbs4te.pas 2.2 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485
  1. program eigbs4te;
  2. uses
  3. typ,
  4. iom,
  5. omv,
  6. eig;
  7. const
  8. n1 = -100;
  9. n2 = 100;
  10. i1 = -10;
  11. i2 = 10;
  12. rwx = i2 - i1 + 1;
  13. var
  14. ex, nex, nel, p, q, r, s, i, j, ind, n, b, k1, k2, m2, term: ArbInt;
  15. a: array[n1..n2] of ArbFloat;
  16. lam: array[i1..i2] of ArbFloat;
  17. x, e, mat: array[i1..i2, i1..i2] of ArbFloat;
  18. begin
  19. Assign(input, ParamStr(1));
  20. reset(input);
  21. Write(' program results eigbs4te');
  22. case sizeof(ArbFloat) of
  23. 4: writeln('(single)');
  24. 6: writeln('(real)');
  25. 8: writeln('(double)');
  26. end;
  27. Read(nex);
  28. writeln;
  29. writeln('number of examples', nex: 2);
  30. writeln;
  31. for ex := 1 to nex do
  32. begin
  33. writeln('example number', ex: 2);
  34. writeln;
  35. Read(p, q, r, s, n, b, k1, k2);
  36. nel := n * (b + 1) - (b * (b + 1)) div 2;
  37. iomrev(input, a[p], nel);
  38. eigbs4(a[p], n, b, k1, k2, lam[q], x[r, s], rwx, m2, term);
  39. writeln(' n =', n: 2, ' b =', b: 2, ' k1 =', k1: 2, ' k2 =', k2: 2);
  40. writeln(' A = ');
  41. iomwrv(output, a[p], nel, numdig);
  42. writeln;
  43. writeln('term=', term: 2);
  44. if term < 3 then
  45. begin
  46. writeln;
  47. writeln('lambda=');
  48. iomwrv(output, lam[q], k2 - k1 + 1, numdig);
  49. writeln;
  50. writeln(' m2 =', m2: 2);
  51. writeln;
  52. writeln('X=');
  53. iomwrm(output, x[r, s], n, m2 - k1 + 1, rwx, numdig);
  54. ind := p;
  55. for i := 1 to n do
  56. for j := 1 to i do
  57. if j < i - b then
  58. mat[i + r - 1, j + s - 1] := 0
  59. else
  60. begin
  61. mat[i + r - 1, j + s - 1] := a[ind];
  62. ind := ind + 1;
  63. end;
  64. for i := 1 to n do
  65. for j := i + 1 to n do
  66. mat[i + r - 1, j + s - 1] := mat[j + r - 1, i + s - 1];
  67. writeln;
  68. writeln(' matrix A =');
  69. iomwrm(output, mat[r, s], n, n, rwx, numdig);
  70. writeln;
  71. writeln('Ax-lambda.x = ');
  72. omvmmm(mat[r, s], n, n, rwx, x[r, s], m2 - k1 + 1, rwx, e[r, s], rwx);
  73. for j := 1 to m2 - k1 + 1 do
  74. for i := 1 to n do
  75. e[i + r - 1, j + s - 1] := e[i + r - 1, j + s - 1] - lam[q + j - 1] * x[i + r - 1, j + s - 1];
  76. iomwrm(output, e[r, s], n, m2 - k1 + 1, rwx, numdig);
  77. end;
  78. writeln;
  79. writeln('-------------------------------------------');
  80. end;
  81. Close(input);
  82. Close(output);
  83. end.