Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
6
Добавлен:
09.03.2016
Размер:
3.29 Кб
Скачать
uses crt;
const n=4;
m=n+1;
t=' main matrix';
type stroka=array[1..m] of real;
matr= array[1..n] of stroka;
var {a:matr;}
c:real;
i,j:integer;
x:stroka;
const a:matr=((0,4,5,0,4),(0,6,7,2,3),(1,3,4,3,4),(1,3,4,5,6));
{ PRINT }
procedure print(l:string);
var i,j:integer;
begin
writeln(l);
for i:=1 to n do begin
for j:=1 to m do write(' ',a[i,j]:7:3);
writeln
end
end;
{ END PRINT }
{ FORM }
procedure form;
var i,j:integer;
const d:word=5;
begin
randomize;
for i:=1 to n do
for j:=1 to m+1 do a[i,j]:=random(d)
end;
{ END FORM }
procedure Glavny_Element(k:integer);
var i,j,r:integer;
c:real;
begin r:=k;
for i:=r to n-1 do
if a[r,r]=0 then
for j:=r to m do begin c:=a[r,j];
a[r,j]:=a[i+1,j];
a[i+1,j]:=c
end
end;
{ END Glavny_Element }
procedure Iscl(k:integer);
var i,j,r:integer;
begin
r:=k;
Glavny_Element(r);
for j:=r+1 to m do a[r,j]:=a[r,j]/a[r,r]; a[r,r]:=1;
for i:=r+1 to n do if a[i,r]<>0 then begin a[i,r]:=0;
for j:=r+1 to m do a[i,j]:=a[i,j]-a[r,j]
end
end;
{ END ISCL }
procedure Iscl2(k:integer);
var i,j,r,t1:integer;
g:real;
begin
for i:=2 to k do
for t1:=1 to i-1 do
begin g:=a[i-t1,i];
for j:=i+1 to m do a[i-t1,j]:=a[i-t1,j]-a[i,j]*g;
a[i-t1,i]:=a[i-t1,i]-g
end
end;
{ END ISCL2 }
procedure Neviaz;
var i,j:integer;
s:real;
begin
for i:=1 to n do x[i]:=a[i,m];
for i:=1 to n do write(' x[',i,']=',x[i]:5:1);
writeln;
for i:=1 to n do begin s:=0;
for j:=1 to n do s:=a[i,j]*x[j]+s;
writeln(' neviazka=',s-a[i,m]:8)
end
end;
{ MAIN PROGRAMM }
begin
ClrScr;
{form;}
print(t);
for i:=1 to n-1 do Iscl(i);
a[n,n]:=a[n,n]/a[n,n]; a[n,m]:=a[n,m]/a[n,n];
print(t);
Iscl2(n);
print(t);
Neviaz
end.
Соседние файлы в папке graph