Приложение а.

Программа, разработанная на языке программирования Turbo Pascal 7.0

{Метод интегрирования - Рунге - Кутта 4 порядка

Метод оптимизации - Координатного спуска

Определение Kp - Непосредственный}

Uses Crt, Graph;

const n=2; R1=1; R2=1; R3=R2; R4=100; R5=100; L=0.0001; C=0.000001;

delt=0.01; E0=110; Ec=50; Es=50; TT=0.01; w=2*pi/TT;

M=100; h=TT/M; s=2;

P1:array[1..s] of real = (1e-4,1e-6);

Pp:array[1..s] of real = (1e-1,1e-2);

type Matrix=array [1..n,1..n] of real;

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

Vect=array [1..s] of real;

var A:Matrix;

B0,Bc,Bs,B,D0,Dc,Ds,D,Lam,X,X1:Vector;

P:Vect;

grdr,grmd,i,j,k:integer;

X0,Y01,Y02,Y03,xx,xx1,y1,y11,y2,y21,y3,y31,y4,y41,y5,y51,y6,y61:integer;

t,kpmax:real;

kx,ky1,ky2,ky3:real;

def:boolean;

{-Процедура сложения двух матриц---------------

----}

procedure Add_Matr(n:byte;Al,A2:Matrix;var A_rez:Matrix);

var i,j:byte;

begin

for i:=1 to n do

for j:=1 to n do

a_rez[i,j]:=al[i,j]+a2[i,j];

end;

{----- Процедура сложения двух векторов-----------}

procedure Add_Vect(n:byte;B1,B2:Vector;var B_rez: Vector);

var i:byte;

begin

for i:=1 to n do

b_rez[i]:=b1[i]+b2[i];

end;

{---------- Процедура умножения двух матриц --------}

procedure Mult_Matr_Matr(n:byte;A1,A2:Matrix;var A_rez:Matrix);

var i,j,k:byte;

begin

for i:=1 to n do

for j:=1 to n do

begin

a_rez[i,j]:=0;

for k:=1 to n do

a_rez[i,j]:=a_rez[i,j]+a1[i,k]*a2[k,j];

end;

end;

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

procedure Mult_Matr_Vect(n:byte;A:Matrix;X:Vector;var Y:Vector);

var i,j:byte;

begin

for i:=1 to n do

begin

y[i]:=0;

for j:=1 to n do

y[i]:=y[i]+a[i,j]*x[j];

end;

end;

{------- Процедура умножения матрицы на число -------}

procedure Mult_Matr_Sc(n:byte;var A:Matrix;Sc:real);

var i,j:byte;

begin

for i:=1 to n do

for j:=1 to n do

a[i,j]:=a[i,j]*Sc;

end;

{--------- Процедура умножения вектора на число -------}

procedure Mult_Vect_Sc(n:byte;var B:Vector;Sc:real);

var i:byte;

begin

for i:=1 to n do

b[i]:=b[i]*Sc

end;

{-Процедура формирование матриц A, BO,Bc,Bs математической модели-}

procedure Def_A_B(P:Vect);

Var Z:real;

begin

Z:=R5*R1+R3*R1+R5*R3+R2*R5+R2*R3;

A[2,2]:=(-R1-R2-R3)/Z/P[2];

A[2,1]:=(R5*R1+R3*R1+R5*R3+R2*R5)/z/P[2];

B0[2]:=0;

Bc[2]:=0;

Bs[2]:=0;

A[1,2]:=(-R2*R5-R3*R1-R5*R1-R5*R3)/Z/p[1];

A[1,1]:=(-R2*R1*R5-R2*R1*R3-R2*R5*R3)/Z/p[1];

B0[1]:=E0/p[1];

Bc[1]:=Ec/p[1];

Bs[1]:=Es/p[1];

end;

{-Процедура формирования вектора B(t)=B(>+Bc*cos(wt)+Bs*sin(wt)--}

procedure Def_B_t(t:real);

begin

b[1]:=b0[1] + bc[1]*cos(w*t) + bs[1]*sin(w*t);

b[2]:=b0[2] + bc[2]*cos(w*t) + bs[2]*sin(w*t);

end;

{------Функция определения выходной переменной--------}

function U4(X:Vector):real;

Var Z:real;

begin

Z:=R5*R1+R3*R1+R5*R3+R2*R5+R2*R3;

U4:=r2*r3*r5/Z*X[1]+(r1+r3+r2)*r5/Z*X[2];

end;

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

procedure Obr_Matr(A:Matrix;var A_obr:Matrix);

var det:real;

begin

det:=a[1,1]*a[2,2]-a[1,2]*a[2,1];

a_obr[1,1]:=a[2,2]/det;

a_obr[1,2]:=-a[1,2]/det;

a_obr[2,1]:=-a[2,1]/det;

a_obr[2,2]:=a[1,1]/det;

end;

{--------Формирование единичной матрицы-----------}

procedure E_Matr(n:byte;var E:Matrix);

var i,j:byte;

begin

for i:=1 to n do

begin

for j:=1 to n do

e[i,j]:=0;

e[i,i]:=1;

end;

end;

{--Определение собственных чисел матрицы второго порядка-----}

procedure Det_L(A:Matrix;var L:Vector;var comp:boolean);

var p0,p1,D:real;

begin

p1:=-(a[1,1]+a[2,2]);

p0:=a[1,1]*a[2,2]-a[1,2]*a[2,1];

D:=p1*p1-4*p0;

if D>0

then begin

comp:=false;

l[1]:=-(-p1+sqr(D))/2;

l[2]:=(-p1-sqr(D))/2.

end

else begin

comp:=true;

l[1]:=-p1/2;

l[2]:=sqrt(-D)/2;

end

end;

{Определение векторов DO, DC, Ds для аналитического решения (2.8,2.9)}

procedure Def_An;

var Z1,Z2:Matrix;

Y1,Y2:Vector;

begin

Obr_Matr(A,Z1);

Mult_Matr_Vect(n,Z1,B0,D0);

Mult_Vect_Sc(n,D0,-1);

Mult_Matr_Matr(n,A,A,Z1);

E_Matr(n,Z2);

Mult_Matr_Sc(n,Z2,4*pi*pi/TT/TT);

Add_Matr(n,Z1,Z2,Z2);

Obr_Matr(Z2,Z1);

Mult_Matr_Vect(n,A,Bc,Y1);

Y2:=Bs;

Mult_Vect_Sc(n,Y2,w);

Add_Vect(n,Y1,Y2,Y1);

Mult_Matr_Vect(n,Z1,Y1,Dc);

Mult_Vect_Sc(n,Dc,-1);

Y1:=Bc;

Mult_Vect_Sc(n,Y1,w);

Mult_Matr_Vect(n,A,Bs,Y2);

Mult_Vect_Sc(n,Y2,-1);

Add_Vect(n,Y1,Y2,Y1);

Mult_Matr_Vect(n,Z1,Y1,Ds);

end;

{-Определение аналитического решения D(t)=DO+Dc*cos(wt)+Ds*sin(wt)-}

procedure Def_An_t(t:real);

var Y:Vector;

begin

Y:=Dc;

Mult_Vect_Sc(n,Y,cos(w*t));

Add_Vect(n,D0,Y,D);

Y:=Ds;

Mult_Vect_Sc(n,Y,sin(w*t));

Add_Vect(n,D,Y,D);

end;

{---------Рунге - Кутта 4-----------------}

Procedure Rung_Kut_4( n:integer; A:Matrix; B:Vector; h:real; var X:Vector);

var Z1,Z2,Z3,Z4,Y:Vector;

begin

Mult_Matr_Vect(n,A,X,Z1);

Add_Vect(n,Z1,B,Z1);

Mult_Vect_Sc(n,Z1,h);

Y:=Z1;

Mult_Vect_Sc(n,Y,1/2);

Add_Vect(n,Y,X,Y);

Mult_Matr_Vect(n,A,Y,Z2);

Add_Vect(n,Z2,B,Z2);

Mult_Vect_Sc(n,Z2,h);

Y:=Z2;

Mult_Vect_Sc(n,Y,1/2);

Add_Vect(n,Y,X,Y);

Mult_Matr_Vect(n,A,Y,Z3);

Add_Vect(n,Z3,B,Z3);

Mult_Vect_Sc(n,Z3,h);

Y:=Z3;

Add_Vect(n,Y,X,Y);

Mult_Matr_Vect(n,A,Y,Z4);

Add_Vect(n,Z4,b,Z4);

Mult_Vect_Sc(n,Z4,h);

Add_Vect(n,Z2,Z3,Z3);

Mult_Vect_Sc(n,Z3,2);

Add_Vect(n,Z3,Z4,Z3);

Add_Vect(n,Z3,Z1,Z3);

Mult_Vect_Sc(n,Z3,1/6);

Add_Vect(n,X,Z3,X);

end;

{-------Инициализация графического режима-----------}

Procedure Init;

begin

grdr:=detect;

InitGraph(grdr,grmd,'c:\distr\bp.7\bgi');

X0:=15;

Y01:=150;

Y02:=300;

Y03:=450;

line(X0,5,X0,GetMaxY-5);

line(X0-5,Y01,GetMaxX-5,Y01);

line(X0-5,Y02,GetMaxX-5,Y02);

line(X0-5,Y03,GetMaxX-5,Y03);

outtextXY(X0+5,5,'x1');

outtextxy(X0+5,Y01+10,'x2');

outtextxy(X0+5,Y02+10,'U5');

outtextxy(GetMaxX-10,Y01+5,'t');

outtextxy(GetMaxX-10,Y02+5,'t');

outtextxy(GetMaxX-10,Y03+5,'t');

end;

{-----------Вычисление нормы матрицы------------}

Function Norm(n:byte;A:Matrix):real;

var j,i:byte;

max,sum:real;

begin

max:=abs(a[1,1]);

for j:=1 to n do

begin

sum:=0;

for i:=1 to n do

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

if sum>max then max:=sum;

end;

Norm:=max;

end;

{-------Вычисление экспоненциальной матрицы---------}

Procedure M_Exp(n:byte;A:Matrix;t:real;var Exp_M:Matrix);

var i,s:byte;

Z1,Z2,Z3:Matrix;

ss:real;

begin

ss:=Norm(n,A);

s:=round(ln(10*t*ss)/ln(2));

E_Matr(n,Z1);

Z2:=Z1;Z3:=Z2;

for i:=1 to s do

begin

Mult_Matr_Matr(n,A,Z2,Z3);

Mult_Matr_Sc(n,Z3,t/exp(s*ln(2))/i);

Add_Matr(n,Z1,Z3,Z1);

Z2:=Z3

end;

for i:=1 to s do

begin

Mult_Matr_Matr(n,Z1,Z1,Z2);

Z1:=Z2;

end;

Exp_M:=Z1;

end;

{-Определение периодического решения непосредственным методом--}

Procedure Def_Nep(var X:Vector);

var Z1,Z2:Matrix;

Y:Vector;

begin

y[1]:=0;

y[2]:=0;

for i:=1 to M do

begin

t:=i*h;

Def_B_t(t);

Rung_Kut_4(n,A,B,h,Y);

end;

Det_L(A,Lam,def);

M_Exp(n,A,TT,Z1);

Mult_Matr_Sc(n,Z1,-1);

E_Matr(n,Z2);

Add_Matr(n,Z1,Z2,Z2);

Obr_Matr(Z2,Z1);

Mult_Matr_Vect(n,Z1,Y,X);

end;

{------Построение графика периодического решения --------}

procedure Per_Solve(P:Vect);

begin

Def_A_B(P);

Def_An;

Def_Nep(X);

Init;

kx:=(GetMaxX-X0-10)/TT;

ky1:=20/50;

ky2:=20/200;

ky3:=20/200;

Def_An_t(0);

xx1:=X0;

y11:=Y01-round(ky1*x[1]);

y21:=Y02-round(ky2*x[2]);

y31:=Y01-round(ky1*d[1]);

y41:=Y02-round(ky2*d[2]);

y51:=Y03-round(ky3*U4(X));

y61:=Y03-round(ky3*U4(D));

for i:=1 to M do

begin

t:=i*h;

Def_An_t(t);

Def_B_t(t);

Rung_Kut_4(n,A,B,h,X);

xx:=X0+round(kx*t);

y1:=Y01-round(ky1*x[1]);

y2:=Y02-round(ky2*x[2]);

y3:=Y01-round(ky1*d[1]);

y4:=Y02-round(ky2*d[2]);

y5:=Y03-round(ky3*U4(X));

y6:=Y03-round(ky3*U4(D));

setcolor(Red);

line(xx1,y11,xx,y1);

line(xx1,y21,xx,y2);

line(xx1,y51,xx,y5);

setcolor(Green);

line(xx1,y31,xx,y3);

line(xx1,y41,xx,y4);

line(xx1,y61,xx,y6);

xx1:=xx;y11:=y1;y21:=y2;y31:=y3;y41:=y4;y51:=y5;y61:=y6;

end;

readln;

CloseGraph;

end;

{------------Метод установления----------------}

procedure Ust(P:Vect);

begin

Def_A_B(P);

x[1]:=0;

x[2]:=0;

j:=0;

repeat

j:=j+1;

X1:=X;

for i:=1 to M do

begin

t:=i*h;

Def_B_t(t);

Rung_Kut_4(n,A,B,h,X);

end;

def:=true;

for i:=1 to n do

if abs(x[i]-x1[i])-delt*abs(x[i]+x1[i])/2>=0

then def:=false;

until def;

Init;

kx:=(GetMaxX-X0-10)/TT/j;

ky1:=20/50;

ky2:=20/200;

ky3:=20/200;

x[1]:=0; x[2]:=0;

{ Init;}

xx1:=X0;y11:=Y01;y21:=Y02;y31:=Y03;

for k:=0 to j-1 do

for i:=1 to M do

begin

t:=i*h+k*TT;

Def_B_t(t);

Rung_Kut_4(n,A,B,h,X);

xx:=X0+round(kx*t);

y1:=Y01-round(ky1*x[1]);

y2:=Y02-round(ky2*x[2]);

y3:=Y03-round(ky3*U4(X));

setcolor(Red);

line(xx1,y11,xx,y1);

line(xx1,y21,xx,y2);

line(xx1,y31,xx,y3);

xx1:=xx; y11:=y1; y21:=y2; y31:=y3;

end;

readln;

CloseGraph;

end;

{--Определение коэффициента пульсации по решению непосредственным-методом--}

Function Kp_nep (P:Vect):real;

var Usr,Umax,Umin:real;

begin

Def_A_B(P);

Def_Nep(X);

Usr:=0; Umin:=U4(X); Umax:=Umin;

for i:=1 to M do

begin

t:=i*h;

Def_B_t(t);

Rung_Kut_4(n,A,B,h,X);

Usr:=Usr+U4(X);

if U4(X)>Umax Then Umax:=U4(X);

if U4(X)<Umin Then Umin:=U4(X);

end;

Kp_nep:=(Umax-Umin)*M/Usr/2;

end;

{-----------Метод золотого сечения---------------}

function Gold(P:Vect;i:byte):real;

const g=0.618034;

var r,xl,xp:real;

X1,X2:Vect;

begin

xp:=pp[i]; xl:=p1[i]; X1:=P; X2:=P;

repeat

r:=g*(xp-xl);

x1[i]:=xl+r;

x2[i]:=xp-r;

if Kp_nep(X1)<Kp_nep(X2)

then xp:=x1[i]

else xl:=x2[i]

until abs(xp-xl)-delt*abs(xp+xl)/2<0;

Gold:=(xp+xl)/2;

end;

{----------Метод координатного спуска-------------}

procedure Koord(var Pmin:Vect;var Kpmin:real);

var i:byte;

P,P1:Vect;

def:boolean;

begin

for i:=1 to s do

p[i]:=(p1[i]+pp[i])/2;

repeat

P1:=P;

for i:=1 to s do

p[i]:=Gold(P,i);

def:=true;

for i:=1 to s do

if abs(p[i]-p1[i])-delt*abs(p[i]+p1[1])/2>=0

then def:=false;

until def;

for i:=1 to s do

pmin[i]:=(p[i]+p1[i])/2;

Kpmin:=Kp_nep(Pmin);

end;

{------Управляющая программа------------}

Begin

Koord(P,kpmax); {оптимизация методом координатного спуска}

Def_A_B(P);

Det_L(A,Lam,def); {определение собственных чисел}

writeln (':Оптимальная точка');

writeln ('p[1]=',p[1]:6:6,' p[2]=',p[2]:6:6,' kpmax=',kpmax:6:6);

writeln('Собственные числа:');

if not def

then begin

writeln('l[1]=',lam[1]); writeln('l[2]=:',lam[2]);

writeln(' Постоянные времени:');

writeln('taul=',1/abs(lam[1]));

writeln('tau2=',1/abs(lam[2]));

end

else begin

writeln('l[1]=',lam[1],'+j ',lam[2]);

writeln('l[1]=',lam[1],'-j ',lam[2]);

Writeln('Постоянная времени: tau=',1/abs(lam[1]));

Writeln('Собственная частота: fc=',lam[2]/2/pi);

end;

readln;

Ust(P); {определение периодического решения методом установления}

Per_Solve(P); {определение периодического решения

аналитическим и непосредственным методами }

end.