Developing.ru

program broiden;
uses crt;
const m=20;
n=20;
type matr=array[1..m, 1..n] of real;
mass=array[1..m, 1..n] of real;
P=array[1..n] of real;
V=array[1..n] of real;
Bnach=array[1..n] of real;
Q=array[1..n] of real;
XJ=array [1..n] of real;
Y=array [1..n] of real;
VB=array [1..m,1..n] of real;
ymnMAS=array [1..n] of real;
PRMAS=array [1..n] of real;


var x0,x1,f,e,S,SYM,pomny,zap,promq,mq,nq:real;
a,w: matr;
k:Bnach;
z:mass;
r:V;
t:P;
m1:Q;
u:XJ;
q1:Y;
b:VB;
mn:ymnMAS;
nm:PRMAS;
iteraz,i,j,n1,maunI,naid,stop,iter,l,h:integer;
Function f1(x,y:real):real;
begin
f1:=x+y-3;
end;
Function f2(x,y:real):real;
begin
f2:=x*x+y*y-9;
end;
begin
clrscr;
write('Введите начальный вектор= ');
readln(x1);
write ('Введите точность e= ');
readln(e);
maunI:=0; naid:=0; stop:=0; S:=0;
write(' Матрица Якоби= ');
for i := 1 to n do
for j := 1 to n do
begin
write(a[i,j]);
writeln;
end;
while ((maunI)<>10) and ((naid)<>1) and ((stop)<>1) do
begin
inc(maunI);
k[0]:=r[0]+r[1]-3;
k[1]:=r[0]*r[0]+r[1]*r[1]-9;
iteraz:=0;
for i:=0 to n do
for j:=0 to n do
begin
w[i,j]:=a[i,j];
end;
end;
while ((iteraz)<> n-1) do
for h:=0 to n do
begin
k[h]:=k[h]*(-1);
end;
pomny:=z[iter,iter];
for i:=iter+1 to n do
begin
z[iter,j]:=z[iter,j]/pomny;
end;

t[iter]:=t[iter]/pomny;
for i:=iter+1 to n do

zap:=z[i,iter];
for j:=iter to n do
begin
z[i,j]:=z[i,j]-z[iter,j]*zap;

t:=t-t[iter]*zap;
inc(iter);
end;
if z[n-1,n-1]<>0 then
m1[n-1]:=t[n-1]/z[n-1,n-1]

else
begin
m1[n-1]:=0;
end;
SYM:=0;
l:=n-2;
for i:=n-2 to n do
begin
SYM:=0;
for j:=i+1 to n-1 do
begin
SYM:=SYM+z[i,j]*t[j];
if z[i,l]<>0 then
t:=(t-SYM)/z[i,j]
else
begin
t:=0;
dec(l);
end;
end;
end;
promq:=0; mq:=0; nq:=0;
S:=0;
for i:=i+1 to n do
begin
u:=r+m1;
if r>=0 then
promq:=m1+promq
else
begin
promq:=-m1[i]+promq;
if r[i]>=0 then
mq:=mq+r[i]
else
begin
mq:=mq-r[i];
if u[i]>=0 then
nq:=nq +u[i]
else
begin
nq:=nq-u[i];
if mq<>0 then
S:=promq/mq
else
begin
S:=promq/nq;
if S<0 then S:=-S;
if S<e then
writeln(S);
naid:=1;
writeln('Найдено решение ');
end;
for i:=0 to n do
writeln(u[i]);
writeln('Количество итераций ', maunI)
else
begin
if S>20 then
writeln('Процесс расходится ');
stop:=1;
else
begin
if maunI=10 then
writeln('за 10 итераций решение не найдено ');
else
begin
q[0]:=(u[0]+u[1]-3)-k[0];
q[1]:=(u[0]*u[0]+u[1]*u[1]-9)-k[1];
end;
end;
for i:=1 to n do
for j:=1 to n do
b[i,j]:=yakob[i,j];
yakob[i,j]:=0;
for i:=0 to n do
Ymn:=0;
for j:=0 to n do
begin
Ymn:=Ymn+b[i,j]*m[j];
mn[i]:=Ymn;
nm[i]:=Y[i]-mn[i];
del:=0;
for i:=0 to n do
begin
del:=del+m[i]*m[i];
for i:=0 to n do
for j:=0 to n do
begin
yakob[i,j]:=b[i,j]+(( nm[i]*m[j]/del);
for i:=0 to n do
begin
r[i]:=u[i];
end;
end;
end;
end;
end;
end.