Текст подпрограммы и версий
afh4r_p.zip , afh4e_p.zip 		Тексты тестовых примеров
tafh4r_p.zip , tafh4e_p.zip

Подпрограмма:  AFH4R (модуль AFH4R_p)

Назначение

Приведение вещественной симметрической матрицы к симметрической трехдиагональной матрице ортогональными преобразованиями подобия.

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

Подпрограмма AFH4R реализует алгоритм приведения симметрической матрицы А ортогональными подобными преобразованиями к симметрической трехдиагональной форме F = QTАQ, где Q - пpоизведение оpтогональных симметpических матpиц отpажения.

Уилкинсон, Райнш. Справочник алгоритмов на языке АЛГОЛ. Линейная алгебра, М., "Машиностроение", 1976.

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

procedure AFH4R(N :Integer; var A :Array of Real;
                var D :Array of Real; var E :Array of Real);


   Параметры
N - порядок исходной матрицы (тип: целый);
A - вещественный двумерный массив размера N*N, содержащий симметрическую матрицу; в результате работы подпрограммы в поддиагональной части массива А в последовательных строках запоминаются векторы, порождающие матрицы отражения Q1, ..., QN - 2;
D - вещественный вектор длины N, содержащий диагональные элементы трехдиагональной матрицы;
E - вещественный вектор длины N, содержащий в последних N - 1 компонентах поддиагональные элементы симметрической трехдиагональной матрицы. Первый элемент Е произволен. 
   Версии
AFH4E - приведение симметрической матрицы, заданной с расширенной (Extended) точностью, к симметрической трехдиагональной матрице ортогональными преобразованиями подобия. 
   Вызываемые подпрограммы:  нет 
   Замечания по использованию
 

Исходную матрицу А можно задавать лишь нижним треугольником.

Подпрограмма АFН4R сохраняет только полный верхний треугольник массива А, в остальных компонентах этого массива размещается информация об ортогональных преобразованиях.

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

Unit TAFH4R_p;
interface
uses
SysUtils, Math, { Delphi }
Lstruct, Lfunc, UtRes_p, AFH4R_p;

function TAFH4R: String;

implementation

function TAFH4R: String;
var
J,I,_i :Integer;
EV :Array [0..3] of Real;
RАВ :Array [0..3] of Real;
const
A :Array [0..15] of Real = ( 1.0,0.42,0.54,0.66,0.42,1.0,0.32,0.44,0.54,0.32,
1.0,0.22,0.66,0.44,0.22,1.0 );
begin
Result := '';  { результат функции }
Result := Result + #$0D#$0A;
for I:=1 to 4 do
 begin
  for J:=1 to 4 do
   begin
    Result := Result + Format('#$0D#$0A +  ВСЕ СОБСТВЕННЫЕ ЗНАЧЕНИЯ  ВЕЩЕСТВЕННОЙ СИММЕТРИЧЕСКОЙ МАТРИЦЫ + #$0D#$0A +  A%20.16f ',
 [A[(I-1)+(J-1)*4]]) + #$0D#$0A;
   end;
 end;
Result := Result + #$0D#$0A;
AFH4R(4,A,EV,RAB);
Result := Result + Format('%s',[#$0D#$0A + ' PEЗУЛЬTAT']) + #$0D#$0A; 
Result := Result + #$0D#$0A;
for I:=1 to 4 do
 begin
  for J:=1 to 4 do
   begin
    Result := Result + Format('#$0D#$0A +  A%20.16f ',
 [A[(I-1)+(J-1)*4]]) + #$0D#$0A;
   end;
 end;
Result := Result + #$0D#$0A;
Result := Result + Format('%s',[#$0D#$0A + ' EV']);
Result := Result + #$0D#$0A;
for _i:=0 to 3 do
 begin
  Result := Result + Format('%20.16f ',[EV[_i]]);
  if ( ((_i+1) mod 4)=0 )
   then Result := Result + #$0D#$0A;
 end;
Result := Result + #$0D#$0A;
Result := Result + Format('%s',[#$0D#$0A + ' RAB']);
Result := Result + #$0D#$0A;
for _i:=0 to 3 do
 begin
  Result := Result + Format('%20.16f ',[RAB[_i]]);
  if ( ((_i+1) mod 4)=0 )
   then Result := Result + #$0D#$0A;
 end;
Result := Result + #$0D#$0A;
UtRes('TAFH4R',Result);  { вывод результатов в файл TAFH4R.res }
exit;
end;

end.


Результаты:

                 | 1.00   0.42   0.54   0.66 |
      A  =    | 0.18   1.00   0.32   0.44 |
                 | 0.42   0.58   1.00   0.22 |
                 | 0.66   0.44   1.04   1.00 |

                 | 0.6670 |
      D  =    | 0.6501 |
                 | 1.6829 |
                 | 1.0000 |

                 |  0.0000 |
      E  =     | -0.0879 |
                 | -0.4614 |
                 | -0.8232 |