Определение минимального собственного значения эрмитовой матрицы

const
  N = 100;
 
type
  Tmatr = array [1..N, 1..N] of real;
 
function f(i, k: integer; a: real): real;//задание элементов матрицы
begin
  f := sin(exp(0.55 * ln(i + k) / ln(i + k + a)));
end;
 
procedure Per(k, n: integer; var a: Tmatr; var p: integer);
var
  i, j: integer;
  z: real;
begin
  z := a[k, k];i := k;p := 0; //после каждого преобразования
  for j := k + 1 to n do   //ищем по оставшимся строкам
  begin
    if abs(a[j, k]) > z then //максимальный по модулю элемент
    begin
      z := abs(a[j, k]);i := j; //запоминаем номер строки
      p := p + 1;//считаем количество перестановок, т.к. при каждой 
      //перестановке меняется знак определителя
    end;
  end;
  if i > k then  //если эта строка ниже данной
    for j := k to n do
    begin
      z := a[i, j];a[i, j] := a[k, j];a[k, j] := z;//перестановка
    end;
end;
 
function znak(p: integer): integer;//ф-я определения знака определителя
begin
  if p mod 2 = 0 then //если четное количество перестановок, "+" , если нет "-"
    znak := 1 else znak := -1;
end;
 
procedure opr(n: integer; var a: Tmatr; var det: real);//собственно определитель
var
  k, i, j, p: integer;
  r: real;
begin
  det := 1;
  for k := 1 to n do  //считаем по алгоритму, который во всех учебниках 
  begin
    if a[k, k] = 0 then per(k, n, a, p);//если главный элемент=0, делаем перестановку
    det := znak(p) * det * a[k, k]; //меняем знак определителя
    for j := k + 1 to n do  //делаем преобразования
    begin
      r := a[j, k] / a[k, k];
      for i := k to n do
      begin
        a[j, i] := a[j, i] - r * a[k, i];
      end;
    end;
  end;
end;
 
var
  E, A1, A2, Am: Tmatr;
  a, b1, b2, s1, s2, sm, l: real;
  i, j: integer;
 
begin//сама программа
  write('a= ');readln(a);
  for i := 1 to 100 do 
    for j := 1 to 100 do
      E[i, j] := f(i, j, a);
  
  l := -100;//ищем нужный отрезок
  repeat
    l := l + 1;
    A1 := E;
    A2 := E;
    for i := 1 to N do A1[i, i] := A1[i, i] - l;
    for i := 1 to N do A2[i, i] := A2[i, i] - l - 1;
    opr(N, A1, s1);opr(N, A2, s2);
    if sign(s1) <> sign(s2) then break;
  until l > 50;
  
  b1 := l;
  b2 := l + 1;
  repeat//ищем собственное значение методом деления отрезка пополам
    A1 := E;
    A2 := E;
    Am := E;
    for i := 1 to N do A1[i, i] := A1[i, i] - b1;
    for i := 1 to N do A2[i, i] := A2[i, i] - b2;
    for i := 1 to N do Am[i, i] := Am[i, i] - (b2 + b1) / 2;
    opr(N, A1, s1);opr(N, A2, s2);opr(N, Am, sm);
    if sign(sm) <> sign(s1) then b2 := (b2 + b1) / 2
    else b1 := (b2 + b1) / 2;
  until (b2 - b1) < 1E-9;
  writeln(b2);
end.