jacobi.PAS

{* Нахождение собственных значений симметричной матрицы методом Якоби *}

Unit JACOBI;
Interface
Implementation
Begin
 writeln('Нахождение собственных значений симметричной матрицы методом Якоби');
End.

Program jacobi;

Uses jacobi.pas; {* Эту строку можно удалить *}
Uses crt; {* Подключаем внешние файлы *}
Const {* Предопределенные *}
  n = 7;
Var {* Объявление переменных *}
  i                : integer;
  j                : integer;
  it               : integer;
  jt               : integer;
  v                : integer;
  s                : integer;
  fi               : real;
  e                : real;
  A                : Array [1..n, 1..n] Of real;
  B                : Array [1..n, 1..n] Of real;
  f                : text;
Function GetSumm : real;
Var {* Объявление переменных *}
  ii         : integer;
  jj         : integer;
  ss         : real;
  Begin
  ss := 0;
For ii := 1 To n Do{* Переменная ii увеличивается с 1 до n *}
  GetSumm := ss;
Var {* Объявление переменных *}
  iii : integer);
  jjj : integer);
Var {* В работе нам потребуются переменные: *}
  ii  : integer;
  jj  : integer;
  max : real;
  Begin
  max := 0.0;
For ii := 1 To n Do {* Увеличиваем ii от 1 до n с шагом 1 *}
  For jj := 1 To n Do {* Переменная jj увеличивается с 1 до n *}
    If (iijj) And (abs(A[ii, jj]) > max) Then
      Begin
max := abs(A[ii, jj]);
iii := ii;
jjj := jj;
End;

End;
Begin
assign(f, 'po5.m'); {* Привязка переменной f к файлу 'po5.m' *}
reset(f); {* Подготовка переменной f для чтения из файла *}
Writeln('A = ');
For i := 1 To n Do {* Увеличиваем i от 1 до n с шагом 1 *}
  Begin
Write('[ ');
For j := 1 To n Do {* Переменная j увеличивается с 1 до n *}
  Begin
read(f, A[i, j]);
write(A[i, j] : 4 : 3, ' ');
End;
Writeln(']');
End;
Writeln; {* Пропускаем одну строку *}
Write('Eps = ');
Readln(e);
Writeln; {metod Yacobi}
While GetSumm > e Do
  Begin
GetMax(it, jt);
fi := 0.5 * arctan(2 * A[it, jt] / (A[it, it] - A[jt, jt]));
For v := 1 To n Do {* Цикл для v => [1 .. n] *}
  Begin
B[v, it] := A[v, it] * cos(fi) + A[v, jt] * sin(fi);
B[v, jt] := - A[v, it] * sin(fi) + A[v, jt] * cos(fi);
End;
For v := 1 To n Do {* Переменная v увеличивается с 1 до n *}
  For s := 1 To n Do {* Цикл для s => [1 .. n] *}
    If (sit) And (sjt) Then
      B[v, s] := A[v, s];
For s := 1 To n Do {* Цикл для s => [1 .. n] *}
  Begin
A[it, s] := B[it, s] * cos(fi) + B[jt, s] * sin(fi);
A[jt, s] := - B[it, s] * sin(fi) + B[jt, s] * cos(fi)
End;
For v := 1 To n Do {* Переменная v увеличивается с 1 до n *}
  For s := 1 To n Do {* Цикл для s => [1 .. n] *}
    If (vit) And (vjt) Then
      A[v, s] := B[v, s];
End;
For i := 1 To n Do {* Переменная i увеличивается с 1 до n *}
  Begin
For j := 1 To n Do {* Увеличиваем j от 1 до n с шагом 1 *}
  Write(abs(A[i, j]) : 0 : 4, ' ');
Writeln; {* Пропускаем одну строку *}
End;
Writeln; {* Вывод пустой строки *}
For i := 1 To n Do {* Переменная i увеличивается с 1 до n *}
  Writeln('l', i, ' = ', A[i, i] : 0 : 4);
close(f); {* Файл f будет закрыт *}
readln; {* Ждем нажатия Enter *}
End......