Процедура ортногонализации / 2008-05-29-19-46-Березовский Андрей-Ortogonalization

program ortogonalization;
uses crt;
type mas=array[1..21,1..21] of real;
     vect=array[1..21] of real;
var a:mas;
    i,j,n:integer;
    x,x1,b:vect;
function skal(a,b:vect;n:integer):real;
var s:real;
    i:integer;
begin
  s:=0;
  for i:=1 to n do
    s:=s+a[i]*b[i];
  skal:=s;
end;
procedure copyrow(a:mas;n:integer;k:integer;var p:vect);
var i:integer;
begin
  for i:=1 to n do
    p[i]:=a[k,i];
end;
procedure countX(a:mas;n:integer;var x:vect);
var r,s1:vect;
    s:mas;
    l:real;
    i,k,j:integer;
begin
  copyrow(a,n,1,r);
  l:=sqrt(skal(r,r,n));
  for i:=1 to n do begin
    s[1,i]:=r[i]/l;
  end;
  for i:=2 to n do begin
    copyrow(a,n,i,r);
    for j:=1 to i-1 do begin
      copyrow(s,n,j,s1);
      l:=skal(s1,r,n);
      for k:=1 to n do
        r[k]:=r[k]-s1[k]*l;
      l:=sqrt(skal(r,r,n));
      for k:= 1 to n do
        s[i,k]:=r[k]/l;
    end;
  end;
  for i:=1 to n-1 do
    x[i]:=r[i]/r[n];
end;
function norma(x:vect;n:integer):real;
var i:integer;
    s:real;
begin
  s:=0;
  for i:=1 to n do
    s:=s+abs(x[i]);
  norma:=s;
end;
begin
  clrscr;
  writeln('Vvedite razmernost matrici:');
  readln(n);
  writeln;
  writeln('Vvod matrici a');
  for i:=1 to n do
    for j:=1 to n do begin
      write('a[',i,',',j,']=');
      readln(a[i,j]);
    end;
  writeln;
  writeln('Vvod vectora x*');
  for i:=1 to n do begin
    write('x*[',i,']=');
    readln(x1[i]);
  end;
  for i:=1 to n do
    for j:=1 to n do
      b[i]:=b[i]+a[i,j]*x1[i];
  writeln;
  writeln('Vector b pri vvedennom x*');
  for i:=1 to n do begin
    write('b[',i,']=',b[i]);
    writeln;
  end;
  for i:=1 to n do
  a[i,n+1]:=-b[i];
  a[n+1,n+1]:=1;
  countX(a,n+1,x);
  writeln;
  writeln('reshenie po metodu ortogonalizacii');
  for i:=1 to n do begin
    write('x[',i,']=',x[i]);
    writeln;
  end;
  writeln;
  writeln('Otnositelna9i pogreshnost:',(abs(norma(x1,n)-norma(x,n)))/norma(x1,n));
  readln;
end.