Текст подпрограммы и версий
agt1r_p.zip  		Тексты тестовых примеров
tagt1r_p.zip 

Подпрограмма:  AGT1R (модуль AGT1R_p)

Назначение

Вычисление всех собственных значений в обобщенной проблеме AX = λBX для вещественных верхней почти треугольной матрицы A и верхней треугольной матрицы B с помощью QR - алгоритма.

Математическое описание

Подпрограмма AGT1R вычисляет все собственные значения обобщенной проблемы Ax = λBx для вещественных верхней почти треугольной матрицы A размера N на N и верхней треугольной матрицы B размера N на N с помощью QR - алгоритма.

Информация о вычисленных собственных значениях обобщенной проблемы выдается в вектоpах ALFR, ALFI, BETA длины N, по которым I - ое собственное значение определяется с помощью формулы: 

         λI = ALFR(I) / BETA(I) + i ALFI(I) / BETA(I) ,  при BETA(I) ≠ 0,
(1)      λI = ∞ ,                                        при BETA(K) = 0,
         λI = любое число ,                              при ALFR(I) = ALFI(I) = BETA(I) = 0.

C.B.Moler, G.W.Stewart, An Algorithm for Generalized Matrix Eigenvalue Problems, SIAM J. Numer. Anal., 10, 1973.

Использование 

procedure AGT1R(var A :Array of Real; var B :Array of Real;
                var ALFR :Array of Real; var ALFI :Array of Real;
                var BETA :Array of Real; N :Integer;
                var IERR :Integer);


   Параметры
A, B - вещественные двумерные массивы размера N на N, содержащие соответственно верхнюю почти треугольную и верхнюю треугольную матрицы;
  ALFR -
  ALFI  
  BETA   		вещественные векторы длины N, содержащие информацию о собственных значениях λk обобщенной проблемы; при этом собственные значения определяются формулой (1);
N - заданный порядок исходных матриц A, B (тип: целый);
IERR - целая переменная, служащая для сообщения об ошибках, обнаруженных в ходе работы подпрограммы; значение IERR полагается равным J+128, где J - номеp собственного значения, для вычисления которого потребовалось более 30 итераций; при этом собственные значения с индексами J+1, ..., N вычислены правильно, а с индексами 1, ..., J могут быть вычислены не точно. 
   Версии :   нет 
   Вызываемые подпрограммы
UTAG10 - подпрограмма выдачи диагностических сообщений при работе подпрограммы AGT1R. 
   Замечания по использованию
  Подпрограмма AGT1R не сохраняет исходную информацию.

Пример использования 

Unit TAGT1R_p;
interface
uses
SysUtils, Math, { Delphi }
Lstruct, Lfunc, UtRes_p, AFG3R_p, AGT1R_p;

function TAGT1R: String;

implementation

function TAGT1R: String;
var
J,I,N,M,IERR :Integer;
ALFR :Array [0..2] of Real;
ALFI :Array [0..2] of Real;
ВЕТА :Array [0..2] of Real;
const
A :Array [0..8] of Real = ( 1.0,-10.0,5.0,0.5,2.0,1.0,0.0,0.0,0.5 );
B :Array [0..8] of Real = ( 0.5,3.0,4.0,0.0,3.0,0.5,0.0,0.0,1.0 );
begin
Result := '';  { результат функции }
Result := Result + Format('%s',
 [' ОПРЕДЕЛЕНИЕ СОБСТВЕННЫХ ЗНАЧЕНИЙ ' + #$0D#$0A +
 ' YРАВНЕНИЯ BИДA:AX=ЛЯMБДA*BX, ГДЕ A - ВЕЩЕСТВЕННАЯ ' + #$0D#$0A +
 ' ВЕРХНЯЯ ПОЧТИ TPEYГОЛЬНАЯ MATPИЦA,' + #$0D#$0A +
 '     B - ВЕЩЕСТВЕННАЯ BEPXHETPEYГОЛЬНАЯ MATPИЦA']) + #$0D#$0A; 
Result := Result + #$0D#$0A;
Result := Result + Format('%s',[' A' + #$0D#$0A]);
for I:=1 to 3 do
 begin
  for J:=1 to 3 do
   begin
    Result := Result + Format(' %20.16f ',[A[(I-1)+(J-1)*3]]) + #$0D#$0A;
   end;
 end;
Result := Result + #$0D#$0A;
Result := Result + #$0D#$0A;
Result := Result + Format('%s',[' B' + #$0D#$0A]);
for I:=1 to 3 do
 begin
  for J:=1 to 3 do
   begin
    Result := Result + Format(' %20.16f ',[B[(I-1)+(J-1)*3]]) + #$0D#$0A;
   end;
 end;
Result := Result + #$0D#$0A;
N := 3;
M := 1;
AFG3R(A,B,A,N,M);
Result := Result + #$0D#$0A;
Result := Result + Format('%s',[' A' + #$0D#$0A]);
for I:=1 to 3 do
 begin
  for J:=1 to 3 do
   begin
    Result := Result + Format(' %20.16f ',[A[(I-1)+(J-1)*3]]) + #$0D#$0A;
   end;
 end;
Result := Result + #$0D#$0A;
Result := Result + #$0D#$0A;
Result := Result + Format('%s',[' B' + #$0D#$0A]);
for I:=1 to 3 do
 begin
  for J:=1 to 3 do
   begin
    Result := Result + Format(' %20.16f ',[B[(I-1)+(J-1)*3]]) + #$0D#$0A;
   end;
 end;
Result := Result + #$0D#$0A;
AGT1R(A,B,ALFR,ALFI,BETA,N,IERR);
Result := Result + Format('%s',[' PEЗYЛЬTAT' + #$0D#$0A]) + #$0D#$0A; 
Result := Result + #$0D#$0A;
Result := Result + Format('%s',[' A' + #$0D#$0A]);
for I:=1 to 3 do
 begin
  for J:=1 to 3 do
   begin
    Result := Result + Format(' %20.16f ',[A[(I-1)+(J-1)*3]]) + #$0D#$0A;
   end;
 end;
Result := Result + #$0D#$0A;
Result := Result + #$0D#$0A;
Result := Result + Format('%s',[' B' + #$0D#$0A]);
for I:=1 to 3 do
 begin
  for J:=1 to 3 do
   begin
    Result := Result + Format(' %20.16f ',[B[(I-1)+(J-1)*3]]) + #$0D#$0A;
   end;
 end;
Result := Result + #$0D#$0A;
Result := Result + #$0D#$0A;
Result := Result + Format('%s',[' ALFR' + #$0D#$0A]);
for I:=1 to 3 do
 begin
  Result := Result + Format('%20.16f ',[ALFR[I-1]]) + #$0D#$0A;
 end;
Result := Result + #$0D#$0A;
Result := Result + #$0D#$0A;
Result := Result + Format('%s',[' ALFI' + #$0D#$0A]);
for I:=1 to 3 do
 begin
  Result := Result + Format('%20.16f ',[ALFI[I-1]]) + #$0D#$0A;
 end;
Result := Result + #$0D#$0A;
Result := Result + #$0D#$0A;
Result := Result + Format('%s',[' BETA' + #$0D#$0A]);
for I:=1 to 3 do
 begin
  Result := Result + Format('%20.16f ',[BETA[I-1]]) + #$0D#$0A;
 end;
Result := Result + #$0D#$0A;
Result := Result + Format('%s',[' IERR' + #$0D#$0A]);
Result := Result + Format('%3d ',[IERR]) + #$0D#$0A;
UtRes('TAGT1R',Result);  { вывод результатов в файл TAGT1R.res }
exit;
end;

end.

Результаты:

       IERR = 0
       ALFR  =  (1.27052,   0.40869,   1.00306)
       ALFI   =  (3.03864,  -0.97744,   0.00000)
       BETA  =  (1.52462,   0.49043,   2.00612)

Собственные значения
   λk  =  (ALFR(k) + i ALFI(k)) / BETA(k),   k  =  1, 2, 3

   λ1  =  0.83333 + 1.9930i
   λ2  =  0.83333 - 1.9930i
   λ3  =  0.50000 + 0.0000i