Точные методы численного решения систем линейных алгебраических уравнений

контрольная работа

3.1 Программа на языке Pascal

program kursovaya;

uses crt;

const sizemat=10;

type mattype=array[1..sizemat,1..sizemat] of double;

mattype1=array[1..sizemat] of double;

{Процедура для вывода матрицы на экран}

procedure writemat (var a:mattype; n,m:byte);

var i,j:byte;

begin

writeln;

for i:=1 to n do

begin

for j:=1 to m do

write(a[i,j]:7:3, );

writeln

end;

end;

{Процедура для ввода значений элементов матрицы}

procedure inputmat (var a:mattype;var d:mattype1; var n:byte);

var i,j:byte;

begin

writeln;

write (Введите размер матрицы = );

readln(n);

writeln;

writeln(Введите матрицу:);

writeln;

for i:=1 to n do

for j:=1 to n do

read (a[i,j]);

writeln;

writeln(Введите свободные коэффициенты:);

writeln;

for i:=1 to n do

readln(d[i]);

writeln;

end;

{Процедура получения двух треугольных матриц, произведение которых равно исходной матрице}

procedure getBnC(var a,b,c:mattype; n:byte);

var k,i,a1,j:byte;

begin

for k:=1 to n do

for i:=1 to n do

begin

if k=i then c[k,i]:=1

else c[k,i]:=0;

b[k,i]:=0;

end;

for a1:=1 to n do

begin

if a1=1 then

begin

for i:=1 to n do

b[i,1]:=a[i,1];

for i:=2 to n do

c[1,i]:=a[1,i]/b[1,1];

end

else

begin

k:=a1;

for i:=a1 to n do

begin

b[i,k]:=a[i,k];

for j:=1 to k-1 do

b[i,k]:=b[i,k]-b[i,j]*c[j,k];

end;

i:=a1;

for k:=i+1 to n do

begin

c[i,k]:=a[i,k];

for j:=1 to i-1 do

c[i,k]:=c[i,k]-b[i,j]*c[j,k];

c[i,k]:=c[i,k]/b[i,i];

end;

end;

end;

end;

procedure otvet(var b,c:mattype; d:mattype1; n:byte);

var x,y,s:mattype1;

i,j,k:byte;

w,q:double;

y1,x1:mattype;

begin

for i:=1 to n do

if i=1 then y[i]:=d[i]/b[i,i]

else

begin

w:=0;

for k:=1 to i-1 do

begin

y1[i,k]:=w+b[i,k]*y[k];

w:=y1[i,k];

end;

y[i]:=(d[i]-w)/b[i,i];

end;

for i:=n downto 1 do

if i=n then x[i]:=y[i]

else

begin

q:=0;

for k:=i+1 to n do

begin

x1[i,k]:=q+c[i,k]*x[k];

q:=x1[i,k];

end;

x[i]:=y[i]-q;

end;

writeln;

writeln(Ответ X:);

writeln;

for i:=1 to n do

writeln(x[,i,]= ,x[i]:1:4);

writeln;

end;

{Основная программа}

var a,a1,c,b:mattype;

d:mattype1;

n:byte;

begin

clrscr;

writeln (Курсовая работа );

InputMat(a,d,n); {Ввод матрицы A }

getBnC(a,b,c,n);{ Получение треугольных матриц B u C}

Writeln(Матрица B: );

writemat(b,n,n);

readln;

Writeln(Матрица C: );

writemat(c,n,n);

otvet(b,c,d,n);

readln;

end.

Делись добром ;)