eigts4te.pas 2.0 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980
  1. program eigts4te;
  2. uses
  3. iom,
  4. typ,
  5. omv,
  6. eig;
  7. const
  8. n1 = -10;
  9. n2 = 8;
  10. n3 = -11;
  11. n4 = 9;
  12. rwx = n4 - n3 + 1;
  13. rwa = rwx;
  14. var
  15. i, j, ex, nex, m2, k1, k2, n, term: ArbInt;
  16. d, cd: array[n1..n2] of ArbFloat;
  17. a, e, x: array[n1..n2, n3..n4] of ArbFloat;
  18. lam: array[n1..n2] of ArbFloat;
  19. begin
  20. Write(' program results eigts4te');
  21. case sizeof(ArbFloat) of
  22. 4: writeln('(single)');
  23. 6: writeln('(real)');
  24. 8: writeln('(double)');
  25. end;
  26. Read(nex);
  27. writeln;
  28. writeln('number of examples', nex: 2);
  29. for ex := 1 to nex do
  30. begin
  31. writeln;
  32. writeln('example number', ex: 2);
  33. Read(n, k1, k2);
  34. iomrev(input, d[1], n);
  35. iomrev(input, cd[2], n - 1);
  36. eigts4(d[1], cd[2], n, k1, k2, lam[k1], x[1, k1], rwx, m2, term);
  37. writeln;
  38. writeln('diag = ');
  39. iomwrv(output, d[1], n, numdig);
  40. writeln;
  41. writeln('codiag = ');
  42. iomwrv(output, cd[2], n - 1, numdig);
  43. writeln;
  44. writeln('k1=', k1: 2, ' k2=', k2: 2);
  45. writeln;
  46. writeln('term=', term: 2);
  47. if term = 1 then
  48. begin
  49. writeln;
  50. writeln('lambda=');
  51. iomwrv(output, lam[k1], k2 - k1 + 1, numdig);
  52. writeln;
  53. writeln(' m2 =', m2: 2);
  54. writeln;
  55. writeln(' X=');
  56. iomwrm(output, x[1, k1], n, m2 - k1 + 1, rwx, numdig);
  57. for i := 1 to n do
  58. for j := 1 to n do
  59. a[i, j] := 0;
  60. for i := 1 to n do
  61. a[i, i] := d[i];
  62. for i := 1 to n - 1 do
  63. a[1 + i, i] := cd[i + 1];
  64. for i := 1 to n - 1 do
  65. a[i, i + 1] := cd[i + 1];
  66. writeln;
  67. writeln('AX-lambda.X = ');
  68. omvmmm(a[1, 1], n, n, rwa, x[1, k1], m2 - k1 + 1, rwx, e[1, k1], rwx);
  69. for j := 1 to m2 - k1 + 1 do
  70. for i := 1 to n do
  71. e[i, j + k1 - 1] := e[i, j + k1 - 1] - lam[k1 + j - 1] * x[i, j + k1 - 1];
  72. iomwrm(output, e[1, k1], n, m2 - k1 + 1, rwx, numdig);
  73. end;
  74. writeln('-----------------------------------------------------');
  75. end;
  76. Close(input);
  77. Close(output);
  78. end.