Текст подпрограммы и версий
ast1r_p.zip , ast1e_p.zip , ast1c_p.zip 		Тексты тестовых примеров
tast1r_p.zip , tast1e_p.zip , tast1c_p.zip

Подпрограмма:  AST1R (модуль AST1R_p)

Назначение

Решение вещественной системы линейных алгебраических уравнений AX = b или ATx = b с треугольной матрицей A.

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

Для заданной вещественной треугольной матрицы А порядка N решается система Аx = b (АTx = b), причем для нахождения компонент решения xi,  i = 1, ..., N система рассматриваEТся как одно векторноE уравНEние 

     x1a1 + ... + xNaN = b ,

где векторы ai,  i = 1, ..., N суть столбцы (строки) матрицы А.

Дж.Форсайт, М.Малькольм, К.Моулер. Машинные методы математических вычислений. М., Мир, 1980.

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

procedure AST1R(var A :Array of Real; M :Integer; N :Integer;
                var B :Array of Real; LTR :Integer; LOW :Integer;
                var IERR :Integer);


   Параметры
A - двумерный массив размера М на N, в котором задается матрица системы (тип: вещественный);
M - первая размерность массива А в вызывающей подпрограмме (тип: целый);
N - порядок матрицы системы (тип: целый);
B - вещественный вектор длины N в котором задается правая часть системы; на выходе содержит вычисленное решение системы (см. замечания по использованию);
LTR - признак решаемой системы (тип: целый), причем
LТR = 0 - если решается система Аx = b,
LТR ≤ 0 - если решается система АTx = b;
LOW - признак решаемой системы (тип: целый), причем
LОW = 0 - если матрица А верхняя треугольная,
LОW ≠ 0 - если матрица А нижняя треугольная;
IERR - целая переменная, содержащая на выходе информацию о прохождении счета; при этом
IЕRR=65 - если М ≤ 0 или N ≤ 0;
IЕRR=66 - если в процессе работы произошло переполнение (это говорит о том, что некоторые компоненты решения системы превосходят по абсолютной величине максимальное представимое на данной машине число);
IЕRR=-К - если в К - й строке матрицы А диагональный элемент равен нулю (это свидетельствует о вырожденности матрицы). Если таких строк несколько, то значение К полагается равным номеру последней из них (см. замечания по использованию);
IЕRR=67 - если система несовместна. 
   Версии
AST1E - решение системы линейных алгебраических уравнений Аx = b или АTx = b с треугольной матрицей А для вещественных А и b, заданных с расширенной (Extended) точностью.
AST1C - решение системы линейных алгебраических уравнений Аx =b или АTx = b с треугольной матрицей А для комплексных А и b. 
   Вызываемые подпрограммы
UTAFSI - подпрограмма выдачи диагностических сообщений. 
   Замечания по использованию
  1. 

В подпрограмме АSТ1E массивы А и В имеют тип Extended.

  2. 

В подпрограмме АSТ1С массивы А и В имеют тип Complex.

  3.  Если вырабатывается значение переменной IЕRR, отличное от нуля, то выдается соответствующее диагностическое сообщение, и если IЕRR > 0, то происходит выход из подпрограммы. Если система совместна, но матрица А вырождена, т.е. для некоторых номеров К  А (К, К) = 0., то полагается  x (К) = 1.

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

Unit TAST1R_p;
interface
uses
SysUtils, Math, { Delphi }
Lstruct, Lfunc, UtRes_p, AST1R_p;

function TAST1R: String;

implementation

function TAST1R: String;
var
M,N,LTR,LOW,J,I,IERR :Integer;
W,S :Real;
A :Array [0..24] of Real;
B :Array [0..4] of Real;
Z :Array [0..4] of Real;
label
_2,_3,_4,_5,_6,_7;
begin
Result := '';  { результат функции }
M := 5;
N := 5;
LTR := 0;
LOW := 0;
for I:=1 to 25 do
  A[I-1] := 0.0;
for J:=1 to N do
 begin
  for I:=J to N do
   begin
    A[(I-1)+(J-1)*5] := 0.0;
_2:
   end;
  for I:=1 to J do
   begin
    A[(I-1)+(J-1)*5] := (I*10+J);
_3:
   end;
  Z[J-1] := (J);
_4:
 end;
for I:=1 to M do
 begin
  B[I-1] := 0.0;
  for J:=I to N do
   begin
    B[I-1] := B[I-1]+A[(I-1)+(J-1)*5]*Z[J-1];
_5:
   end;
_6:
 end;
Result := Result + #$0D#$0A;
Result := Result + Format('%s',['   A=' + #$0D#$0A]);
for I:=1 to M do
 begin
  for J:=1 to N do
   begin
    Result := Result + Format(' %20.16f ',[A[(I-1)+(J-1)*5]]) + #$0D#$0A;
   end;
 end;
Result := Result + #$0D#$0A;
Result := Result + #$0D#$0A;
Result := Result + Format('%s',['   Z=' + #$0D#$0A]);
for J:=1 to N do
 begin
  Result := Result + Format(' %20.16f ',[Z[J-1]]) + #$0D#$0A;
 end;
Result := Result + #$0D#$0A;
AST1R(A,M,N,B,LTR,LOW,IERR);
W := 0.0;
for J:=1 to N do
 begin
  S := Abs(B[J-1]-Z[J-1]);
  if ( S > W ) 
   then W := S;
_7:
 end;
Result := Result + #$0D#$0A;
Result := Result + Format('%s',['   B=' + #$0D#$0A]);
for J:=1 to N do
 begin
  Result := Result + Format(' %20.16f ',[B[J-1]]) + #$0D#$0A;
 end;
Result := Result + #$0D#$0A;
Result := Result + Format('%s',['   W=']);
Result := Result + Format('%20.16f ',[W]) + #$0D#$0A;
Result := Result + Format('%s',['   IERR=']);
Result := Result + Format('%3d ',[IERR]) + #$0D#$0A;
UtRes('TAST1R',Result);  { вывод результатов в файл TAST1R.res }
exit;
end;

end.


Результат:

      B  =   ( 1.000,  2.000,  3.000,  4.000,  5.000 ) .