Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
15
Добавлен:
09.12.2013
Размер:
2.22 Кб
Скачать
Program Matr;
uses crt;
const n=8;
n1=7;
x:array [0..n] of real=(-4, -3, -2, -1, 0, 1, 2, 3, 4);
y:array [0..n] of real=(0, 2, 0, -1, 0, 1, 0,-2, 0);
var m:array [0..n] of real;
a:array [1..7,1..8] of real;
i,j:integer;

procedure Holess;
var m,t,i1,k:integer;
max,p,s:real;
a1:array [0..n] of real;
begin
for m:=1 to n1 do
begin
if m=1 then
for j:=2 to n1+1 do a[1,j]:=a[1,j]/a[1,1];
if m>=2 then
begin
max:=abs(a[m,m]);
for t:=m to n1 do
if abs(a[t,m])>=max then
begin
max:=abs(a[t,m]);
i1:=t;
end;
for i:=1 to n1+1 do a1[i]:=a[m,i];
for i:=1 to n1+1 do
begin
a[m,i]:=a[i1,i];
a[i1,i]:=a1[i];
end;
for i:=m to n1 do
begin
p:=0;
for k:=1 to m-1 do p:=p+a[i,k]*a[k,m];
a[i,m]:=a[i,m]-p
end;
for j:=m+1 to n1+1 do
begin
s:=0;
for k:=1 to m-1 do s:=s+a[m,k]*a[k,j];
a[m,j]:=(a[m,j]-s)/a[m,m];
end;
end;
end;
end;

procedure Res;
var i,k:integer;
s:real;
begin
for i:=n1 downto 1 do
begin
if n1=1 then x[i]:=a[n1,n1+1];
s:=0;
for k:=i+1 to n1 do
s:=s+a[i,k]*x[k];
x[i]:=a[i,n1+1]-s;
writeln('M[',i,']=',x[i]:6:5);
end;
writeln(x[4]+4*x[5]+x[6]:6:5);
end;

begin
clrscr;
m[0]:=(-11*y[0]+18*y[1]-9*y[2]+2*y[3])/6;
m[n]:=(11*y[n]-18*y[n-1]+9*y[n-2]-2*y[n-3])/6;
for i:=1 to 7 do
for j:=1 to 8 do a[i,j]:=0;
for i:=1 to 7 do a[i,i]:=4;
for i:=1 to 6 do
begin
a[i,i+1]:=1;
a[i+1,i]:=1;
end;
a[1,8]:=3*(y[2]-y[0])-m[0];
a[7,8]:=3*(y[8]-y[6])-m[8];
for i:=2 to 6 do a[i,8]:=3*(y[i+1]-y[i-1]);
for i:=1 to 7 do
begin
for j:=1 to 8 do write(a[i,j]:6:5,' | ');
writeln;
end;
Holess;
Res;

{

for i:=1 to 7 do
begin
for j:=1 to 8 do write(a[i,j]:6:5,' | ');
writeln;
end;}
writeln(-2.06599+4*(-0.90034):6:5);
readln;
end.
Соседние файлы в папке лаба №1 крэс-05