СХЕМА ПРОГРАММЫ

Основная программа:

ЛИСТНИНГ программы

Program LU;

const n=10;

Type

ivect = array [1..n] of integer;

rmatr = array [1..n,1..n] of real;

rvect = array [1..n] of real;

function norma(var a:rmatr):real;

var i,j:integer;

s,norm:real;

Begin

norm:=0;

for i:=1 to n do

Begin

s:=0;

for j:=1 to n do s:=s+abs(a[i,j]);

if s>norm then norm:=s;

End;

norma:=norm;

End;

procedure DECOMP(var a:rmatr; var ip,jp:ivect;var eps,det,norm:real;var ifsolve:boolean);

Label 10;

Var

i,j,k,km,im,jm:integer;

s,am:real;

Begin

ifsolve:=true;det:=1.0;norm:=0;

for i:=1 to n do

Begin

ip[i]:=i; jp[i]:=i;

End;

for i:=1 to n do

Begin

s:=0;

for j:=1 to n do s:=s+abs(a[i,j]);

if s>norm then norm:=s;

End;

eps:=eps*norm;

for k:=1 to n-1 do

Begin

am:=abs(a[k,k]);

for i:=k to n do

for j:=k to n do

if abs(a[i,j])>=am then

Begin

im:=i; jm:=j;

am:=abs(a[i,j]);

End;

if (im<>k) then

Begin

for i:=1 to n do

Begin

am:=a[k,i]; a[k,i]:=a[im,i]; a[im,i]:=am;

End;

km:=ip[k]; ip[k]:=ip[im]; ip[im]:=km; det:=-det;

End;

if (jm<>k) then

Begin

for j:=1 to n do

Begin

am:=a[j,k]; a[j,k]:=a[j,jm];

a[j,jm]:=am;

End;

km:=jp[k]; jp[k]:=jp[jm]; jp[jm]:=km; det:=-det;

End;

if abs(a[k,k])>=eps then

for i:=k+1 to n do

Begin

am:=a[i,k]/a[k,k];

a[i,k]:=am;

for j:=k+1 to n do

Begin

a[i,j]:=a[i,j]-am*a[k,j];

End;

End

else begin ifsolve:=false; goto 10 end;

End;

10:

if ifsolve and (abs(a[n,n])>=eps) then

for k:=1 to n do begin

det:=det*a[k,k];

End

else det:=0

End;

procedure SOLVE(var a:rmatr;var ip,jp:ivect;var x:rvect;b:rvect);

Var

y:rvect;

i,j:integer;

s:real;

Begin

for i:=1 to n do

Begin

y[i]:=b[ip[i]];

End;

for i:=2 to n do

Begin

s:=y[i];

for j:=1 to i-1 do

Begin

s:=s-a[i,j]*y[j];

End;

y[i]:=s;

End;

b[n]:=y[n]/a[n,n];

for i:=n-1 downto 1 do

Begin

s:=y[i];

for j:=i+1 to n do s:=s-a[i,j]*b[j];

b[i]:=s/a[i,i];

End;

for i:=1 to n do x[jp[i]]:=b[i];

End;

Var

a,a1,Ao,E:rmatr;

b,b1,x:rvect;

ip,jp:ivect;

f:Text;

eps,det,s,norm1,norm2,cond:real;

i,j,m,k:integer;

ifsolve:boolean;

Begin

writeln('Vvedite nomer SLAU');