Welcome, guest! Login / Register - Why register?
Psst.. new poll here.
Psst.. new forums here.
Microsoft is blocking us again (TY IP Reputation!) so just use oauth login instead. :)

Paste

Pasted as Delphi by katataolu ( 7 years ago )
program praktikakod;
{$APPTYPE CONSOLE}
const n=2;

type
  Matrix=array[1..n,1..n] of real;
  vektor=array[1..n] of real;

procedure create_matrix(var A:Matrix);
var
  i,j:integer;
begin
  for i:=1 to n do
  begin
    for j:=1 to n do
    begin
      read(a[i,j]);

    end;
    writeln;
  end;
end;

procedure print_matrix(var A:Matrix);
var
  i,j:integer;
begin
  for i:=1 to n do
  begin
    for j:=1 to n do
    begin
      write(a[i,j]:6:2);
    end;
    writeln;
  end;

end;

procedure print_ul(var P:Matrix ; t,r:integer);
var
  i,j:integer;
begin
  for i:=1 to t do
  begin
    for j:=1 to r do
    begin
      write(P[i,j]:6:2);

    end;
     writeln;
  end;
end;

Procedure M_LU(A : Matrix ; Var L: Matrix ; Var U :Matrix  );
{ Процедура разложения исходной матрицы на нижнюю и верхнюю треугольные}
{                   A = L  *  U                                         }
{     матрицу А (задана в головной программе ) можно представить :
      L(lower)   :  в виде произведения  нижней  треугольной матрицы
                 (т.е. все элементы выше главной диагонали  у нее нулевые)
      U (upper) :  верхней треугольной  матрицы   (ниже главной
                 диагонали у нее нули , а на главной стоят единицы))}
(* Type  Типы , объявленные в программе:
           Matrix=array[1..n,1..n] of real;
           vektor=array[1..n] of real ; *)
{   n - размерность матрицы  }
Var
  i,j,k,m :integer;
  sum:real;
Begin
  for i:=1 to n do      {Столбец 1 матрицы А переписывается как  }
        L[i,1]:=A[i,1]; {         стобец 1 матрицы L             }
  for j:=2 to n do      {      Определяется строка 1   матрицы U }
        U[1,j]:=A[1,j] / L[1,1];
  {Для разложения матрицы А используется компактная схема метода Гаусса }
  for m:=2 to n do
   begin
     for i:=m to n do         {Заполнение матрицы L}
      begin
          sum:=0;
          for k:=1  to m-1 do  sum:=sum+ L[i,k]*U[k,m];
          L[i,m]:=A[i,m]-sum;
      end;
      for j:=m+1 to n do      {Заполнение матрицы U}
          begin
             sum:=0;
             for k:=1 to m-1 do
                 sum:=sum+ L[m,k]*U[k,j];
             U[m,j]:=(A[m,j] - sum) / L[m,m];
          end;
  end;
    for i:=1 to n do  U[i,i]:=1; {заполнение диагонали матрицы U }
 end;
var
A,U,L:Matrix;
begin
  create_matrix(a);
  print_matrix(A);
  M_LU(A,L,U);
  print_ul(U,n,n);
  print_ul(L,n,n);
  print_matrix(A);
  readln;
  readln;
end.

 

Revise this Paste

Your Name: Code Language: