Процедура ортногонализации / 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.