Лабораторная работа №3 / G

Program Modif_N_1;

Uses Crt;
Const a=3;b=-1.4;c=0.09;d=1.3;e=0.0003;del=0.09;

Var
m,k:Integer;
ya1,al1,al2,func1,func2,l,ax,bx,ala1,ln,Dx1,Dx2,Dx1x1,Dx1x2,Dx2x2,Dx2x1,Opr,OprX1,OprX2,p1,p2,p,al:Real;
X: Array [0..2,1..2] of Real;
x1: Array [0..2,1..2] of Real;
x2: Array [0..2,1..2] of Real;

Function DefX1(X1,X2:real):real;
Begin
DefX1:=A+2*C*X1*exp(C*sqr(X1)+D*sqr(X2));
End;

Function DefX2(X1,X2:Real):Real;
Begin
DefX2:=B+2*D*X2*exp(C*sqr(X1)+D*sqr(X2));
End;

Function DefX1X1(X1,X2:real):real;
Begin
DefX1X1:=2*C*exp(C*sqr(X1)+D*sqr(X2))*(1+2*C*sqr(x1));
End;

Function DefX1X2(X1,X2:real):real;
Begin
DefX1X2:=4*C*D*X1*X2*exp(C*sqr(X1)+D*sqr(X2));
End;

Function DefX2X1(X1,X2:real):real;
Begin
DefX2X1:=4*C*d*X1*X2*exp(C*sqr(X1)+D*sqr(X2));
End;

Function DefX2X2(X1,X2:real):real;
Begin
DefX2X2:=2*D*exp(C*sqr(X1)+D*sqr(X2))*(1+2*D*sqr(x2));
End;

Function Fun(X1,X2:Real):Real;
Begin
Fun:=A*X1+B*X2+exp(C*sqr(X1)+D*sqr(X2));
End;

label a1,a2,a3,a4,a5,a6,qw,b1,b2,b3,b4;

BEGIN

a1:
ClrScr;
WriteLn('Modif_N_1');
Writeln('X[0,1]:=0;x[0,2]:=0 ');
X[0,1]:=0;
X[0,2]:=0;
Writeln('Eps:=0.0003');
k:=5;
DX1:=DefX1(X[0,1],X[0,2]);
DX2:=DefX2(X[0,1],X[0,2]);
DX1X1:=DefX1X1(X[0,1],X[0,2]);
DX1X2:=DefX1X2(X[0,1],X[0,2]);
DX2X1:=DefX2X1(X[0,1],X[0,2]);
DX2X2:=DefX2X2(X[0,1],X[0,2]);
Opr:=DX1X1*DX2X2-DX1X2*DX2X1;

a2:
p1:=(DX2X2*DX1-DX1X2*DX2)/Opr;
p2:=(-DX2X1*DX1+DX1X1*DX2)/Opr;
al:=0.1;

qw:
x[1,1]:=x[0,1]-(al)*p1;
x[1,2]:=x[0,2]-(al)*p2;
x[2,1]:=x[0,1]-(al+0.1)*p1;
x[2,2]:=x[0,2]-(al+0.1)*p2;
If fun(X[2,1],X[2,2])<fun(X[1,1],X[1,2]) then
Begin
al:=al+0.1;
Goto qw;
End
Else Goto b1;

b1:
ax:=0;bx:=al;
l:=(sqrt(5)+1)/2;
al1:=bx-(bx-ax)/l;
X1[1,1]:=X[0,1]-al1*p1;
X1[1,2]:=X[0,2]-al1*p2;
func1:=Fun(X1[1,1],X1[1,2]);
al2:=ax+(bx-ax)/l;
X2[1,1]:=X[0,1]-al2*p1;
X2[1,2]:=X[0,2]-al2*p2;
func2:=Fun(X2[1,1],X2[1,2]);
m:=2;
ln:=1/l;

b2:
While m<21 do
Begin
ln:=ln*l;
If func1<func2 then
Begin
bx:=al2;
al2:=al1;
func2:=func1;
al1:=ax+bx-al2;
X1[1,1]:=X[0,1]-al1*p1;
X1[1,2]:=X[0,2]-al1*p2;
func1:=Fun(X1[1,1],X1[1,2]);
End
Else
Begin
ax:=al1;
al1:=al2;
func1:=func2;
al2:=ax+bx-al1;
x2[1,1]:=X[0,1]-al2*p1;
x2[1,2]:=X[0,2]-al2*p2;
func2:=Fun(X2[1,1],X2[1,2]);
End;
m:=m+1;
End;

b3:
If func1<func2 then
Begin
ala1:=al1;
ya1:=func1;
End
Else
Begin
ala1:=al2;
ya1:=func2;
End;

a4:
X[1,1]:=X[0,1]-ala1*p1;
X[1,2]:=X[0,2]-ala1*p2;

a5:
DX1:=DefX1(X[1,1],X[1,2]);
DX2:=DefX2(X[1,1],X[1,2]);
al:=0.1;
k:=k+2;
a6:
p:=sqrt(sqr(DX1)+sqr(DX2));
if p>e then
Begin
X[0,1]:=X[1,1];X[0,2]:=X[1,2];
Goto a2;
End
Else
Begin
WriteLn;
WriteLn('Xmin[0,1]:=',X[1,1]);
WriteLn('Xmin[0,2]:=',X[1,2]);
WriteLn('Ymin:=',Fun(X[1,1],X[1,2]));
WriteLn('Chislo iteraciy:=',k);
End;
ReadLn;
End.