eigge3te.pas 2.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596
  1. program eigge3te;
  2. uses
  3. typ,
  4. iom,
  5. eig;
  6. const
  7. m1 = -9;
  8. m2 = 5;
  9. m3 = -11;
  10. m4 = 8;
  11. n1 = -10;
  12. n2 = 8;
  13. n3 = -9;
  14. n4 = 7;
  15. rwa = n2 - n1 + 1;
  16. rwx = n4 - n3 + 1;
  17. var
  18. i, j, l, nex, n, term, i1, j1, i2, j2, k: ArbInt;
  19. r: ArbFloat;
  20. a: array[m1..m2, n1..n2] of ArbFloat;
  21. x: array[m3..m4, n3..n4] of complex;
  22. lam: array[m1..m2] of complex;
  23. begin
  24. Write(' program results eigge3te');
  25. case sizeof(ArbFloat) of
  26. 4: writeln('(single)');
  27. 6: writeln('(real)');
  28. 8: writeln('(double)');
  29. end;
  30. Read(nex);
  31. writeln;
  32. writeln('number of examples', nex: 2);
  33. writeln;
  34. for l := 1 to nex do
  35. begin
  36. writeln('example number', l: 2);
  37. writeln;
  38. Read(i1, j1, i2, j2, n);
  39. iomrem(input, a[i1, j1], n, n, rwa);
  40. eigge3(a[i1, j1], n, rwa, lam[i1], x[i2, j2], rwx, term);
  41. writeln;
  42. writeln('A=');
  43. writeln;
  44. iomwrm(output, a[i1, j1], n, n, rwa, numdig);
  45. writeln;
  46. writeln('term=', term: 2);
  47. writeln;
  48. if term = 1 then
  49. begin
  50. writeln('lambda=');
  51. writeln(' ': 10, 'Re', ' ': 10, 'Im');
  52. for i := 1 to n do
  53. writeln(lam[i1 + i - 1].re: numdig, ' ', lam[i1 + i - 1].im: numdig);
  54. writeln;
  55. writeln('eigenvectors:');
  56. for j := 1 to n do
  57. begin
  58. writeln('eig. vect. nr', j: 2);
  59. writeln(' ': 10, 'Re', ' ': 10, 'Im');
  60. for i := 1 to n do
  61. begin
  62. Write(x[i2 + i - 1, j2 + j - 1].re: numdig, ' ');
  63. writeln(x[i2 + i - 1, j2 + j - 1].im: numdig);
  64. end; {i}
  65. writeln;
  66. end; {j}
  67. writeln('residuals:');
  68. for j := 1 to n do
  69. begin
  70. writeln('residual nr', j: 2);
  71. writeln(' ': 10, 'Re', ' ': 10, 'Im');
  72. for i := 1 to n do
  73. begin
  74. r := 0;
  75. for k := 1 to n do
  76. r := r + a[i1 + i - 1, j1 + k - 1] * x[i2 + k - 1, j2 + j - 1].re;
  77. r := r - lam[i1 + j - 1].re * x[i2 + i - 1, j2 + j - 1].re;
  78. r := r + lam[i1 + j - 1].im * x[i2 + i - 1, j2 + j - 1].im;
  79. Write(r: numdig, ' ');
  80. r := 0;
  81. for k := 1 to n do
  82. r := r + a[i1 + i - 1, j1 + k - 1] * x[i2 + k - 1, j2 + j - 1].im;
  83. r := r - lam[i1 + j - 1].re * x[i2 + i - 1, j2 + j - 1].im;
  84. r := r - lam[i1 + j - 1].im * x[i2 + i - 1, j2 + j - 1].re;
  85. writeln(r: numdig);
  86. end; {i}
  87. writeln;
  88. end; {j}
  89. end; {term=1}
  90. writeln('-------------------------------------------');
  91. end; {l}
  92. Close(input);
  93. Close(output);
  94. end.