Оптимальное проектирование технических систем на ЭВМ / Конечные_Системы(4,5) / Runge

unit Runge;

interface

procedure RK(x10,x20,x30,x40,w1,w2,r1,r2,g,h,q0,wq,t:real;v:boolean;
var x1,x2,x3,x4:real);
procedure RKS(x10,x20,x30,x40,w1,w2,r1,r2,g,h,q,dq,t:real;
var x1,x2,x3,x4:real);

implementation

procedure RK(x10,x20,x30,x40,w1,w2,r1,r2,g,h,q0,wq,t:real;v:boolean;
var x1,x2,x3,x4:real);
//var k11,k12,k13,k14,k21,k22,k23,k24,
// k31,k32,k33,k34,k41,k42,k43,k44:Extended;
begin
{if v then
begin
k11:=h*x20;
k12:=h*(-r1*(x20-x40)-sqr(w1)*(x10-x30));
k13:=h*x40;
k14:=h*(g*(r1*(x20-x40)+sqr(w1)*(x10-x30))-r1*(x40-q0*wq*cos(wq*t))-sqr(w2)*(x30-q0*sin(wq*t)));
k21:=h*(x20+0.5*k12);
k22:=h*(-r1*(x20+0.5*k12-x40-0.5*k14)-sqr(w1)*(x10+0.5*k11-x30-0.5*k13));
k23:=h*(x40+0.5*k14);
k24:=h*(g*(r1*(x20+0.5*k12-x40-0.5*k14)+sqr(w1)*(x10+0.5*k11-x30-0.5*k13))-r1*(x40+0.5*k14)-sqr(w2)*(x30+0.5*k13));
k31:=h*(x20+0.5*k22);
k32:=h*(-r1*(x20+0.5*k22-x40-0.5*k24)-sqr(w1)*(x10+0.5*k21-x30-0.5*k23));
k33:=h*(x40+0.5*k24);
k34:=h*(g*(r1*(x20+0.5*k22-x40-0.5*k24)+sqr(w1)*(x10+0.5*k21-x30-0.5*k23))-r1*(x40+0.5*k24)-sqr(w2)*(x30+0.5*k23));
k41:=h*(x20+k32);
k42:=h*(-r1*(x20+k32-x40-k34)-sqr(w1)*(x10+k31-x30-k33));
k43:=h*(x40+k34);
k44:=h*(g*(r1*(x20+k32-x40-k34)+sqr(w1)*(x10+k31-x30-k33))-r1*(x40+k34)-sqr(w2)*(x30+k33));
end
else
begin
k11:=h*x20;
k12:=h*(-r1*(x20-x40)-sqr(w1)*(x10-x30));
k13:=h*x40;
k14:=h*(g*(r1*(x20-x40)+sqr(w1)*(x10-x30))-r1*x40-sqr(w2)*x30);
k21:=h*(x20+0.5*k12);
k22:=h*(-r1*(x20+0.5*k12-x40-0.5*k14)-sqr(w1)*(x10+0.5*k11-x30-0.5*k13));
k23:=h*(x40+0.5*k14);
k24:=h*(g*(r1*(x20+0.5*k12-x40-0.5*k14)+sqr(w1)*(x10+0.5*k11-x30-0.5*k13))-r1*(x40+0.5*k14)-sqr(w2)*(x30+0.5*k13));
k31:=h*(x20+0.5*k22);
k32:=h*(-r1*(x20+0.5*k22-x40-0.5*k24)-sqr(w1)*(x10+0.5*k21-x30-0.5*k23));
k33:=h*(x40+0.5*k24);
k34:=h*(g*(r1*(x20+0.5*k22-x40-0.5*k24)+sqr(w1)*(x10+0.5*k21-x30-0.5*k23))-r1*(x40+0.5*k24)-sqr(w2)*(x30+0.5*k23));
k41:=h*(x20+k32);
k42:=h*(-r1*(x20+k32-x40-k34)-sqr(w1)*(x10+k31-x30-k33));
k43:=h*(x40+k34);
k44:=h*(g*(r1*(x20+k32-x40-k34)+sqr(w1)*(x10+k31-x30-k33))-r1*(x40+k34)-sqr(w2)*(x30+k33));
end;
x1:=x10+(k11+2*k21+2*k31+k41)/6;
x2:=x20+(k12+2*k22+2*k32+k42)/6;
x3:=x30+(k13+2*k23+2*k33+k43)/6;
x4:=x40+(k14+2*k24+2*k34+k44)/6; }
end;

procedure RKS(x10,x20,x30,x40,w1,w2,r1,r2,g,h,q,dq,t:real;
var x1,x2,x3,x4:real);
var k11,k12,k13,k14,k21,k22,k23,k24,
k31,k32,k33,k34,k41,k42,k43,k44:Extended;
begin
k11:=h*x20;
k12:=h*(-r1*(x20-x40)-sqr(w1)*(x10-x30));
k13:=h*x40;
k14:=h*(g*(r1*(x20-x40)+sqr(w1)*(x10-x30))-r2*(x40-dq)-sqr(w2)*(x30-q));
k21:=h*(x20+0.5*k12);
k22:=h*(-r1*(x20+0.5*k12-x40-0.5*k14)-sqr(w1)*(x10+0.5*k11-x30-0.5*k13));
k23:=h*(x40+0.5*k14);
k24:=h*(g*(r1*(x20+0.5*k12-x40-0.5*k14)+sqr(w1)*(x10+0.5*k11-x30-0.5*k13))-r2*(x40+0.5*k14-dq)-sqr(w2)*(x30+0.5*k13-q));
k31:=h*(x20+0.5*k22);
k32:=h*(-r1*(x20+0.5*k22-x40-0.5*k24)-sqr(w1)*(x10+0.5*k21-x30-0.5*k23));
k33:=h*(x40+0.5*k24);
k34:=h*(g*(r1*(x20+0.5*k22-x40-0.5*k24)+sqr(w1)*(x10+0.5*k21-x30-0.5*k23))-r2*(x40+0.5*k24-dq)-sqr(w2)*(x30+0.5*k23-q));
k41:=h*(x20+k32);
k42:=h*(-r1*(x20+k32-x40-k34)-sqr(w1)*(x10+k31-x30-k33));
k43:=h*(x40+k34);
k44:=h*(g*(r1*(x20+k32-x40-k34)+sqr(w1)*(x10+k31-x30-k33))-r2*(x40+k34-dq)-sqr(w2)*(x30+k33-q));
x1:=x10+(k11+2*k21+2*k31+k41)/6;
x2:=x20+(k12+2*k22+2*k32+k42)/6;
x3:=x30+(k13+2*k23+2*k33+k43)/6;
x4:=x40+(k14+2*k24+2*k34+k44)/6;
end;
end.