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

unit uRunge;
interface
Uses ComCtrls;
Type

TQu = record
x1,x2,x3,x4 : Double;
t : Double;
end;

TVect = array of TQu;

TRunge = class
private
X0 : TQu;
m1,m2,c1,c2,k1,k2: Double;
w1,w2,r1,r2,g: Double;
public
h,T,q,Wq : Double;
Values : TVect;
Size: Integer;
procedure Step(mode :Boolean; t,q :Double);
constructor Create(m1 : Double; m2 : Double; c1 : Double;c2 : Double;k1 : Double;k2 : Double;x01 : Double;x02 : Double;x03 : Double;x04 : Double;h : Double;T : Double;q : Double;wq : Double);
procedure Run(mode :Boolean);
end;

implementation

procedure TRunge.Step(mode :Boolean; t,q :Double);
var
k: array [1..4,1..4] of Double;
begin
FillChar(k,16,0);
if mode then
begin
k[1,1] := h * X0.x2;
k[1,2] := h * (-r1 * (X0.x2 - X0.x4) - w1*w1 * (X0.x1 - X0.x3));
k[1,3] := h * X0.x4;
k[1,4] := h * (g * (r1 * (X0.x2 - X0.x4) + w1*w1 * (X0.x1 - X0.x3)) -
r2 * (X0.x4 - q * wq * cos(wq * t)) - w2*w2 * (X0.x3 - q * sin(wq * t)));

k[2,1] := h * (X0.x2 + 0.5 * k[1][2]);
k[2,2] := h * (-r1 * (X0.x2 + 0.5 * k[1][2] - X0.x4 - 0.5 * k[1][4]) -
w1*w1 * (X0.x1 + 0.5 * k[1][1] - X0.x3 - 0.5 * k[1][3]));
k[2,3] := h * (X0.x4 + 0.5 * k[1][4]);
k[2,4] := h * (g * (r1 * (X0.x2 + 0.5 * k[1][2] - X0.x4 - 0.5 * k[1][4]) +
w1*w1 * (X0.x1 + 0.5 * k[1][1] - X0.x3 - 0.5 * k[1][3])) -
r2 * (X0.x4 + 0.5 * k[1][4]) - w2*w2 * (X0.x3 + 0.5 * k[1][3]));

k[3,1] := h * (X0.x2 + 0.5 * k[2][2]);
k[3,2] := h * (-r1 * (X0.x2 + 0.5 * k[2][2] - X0.x4 - 0.5 * k[2][4]) -
w1*w1 * (X0.x1 + 0.5 * k[2][1] - X0.x3 - 0.5 * k[2][3]));
k[3,3] := h * (X0.x4 + 0.5 * k[2][4]);
k[3,4] := h * (g * (r1 * (X0.x2 + 0.5 * k[2][2] - X0.x4 - 0.5 * k[2][4]) +
w1*w1 * (X0.x1 + 0.5 * k[2][1] - X0.x3 - 0.5 * k[2][3])) -
r2 * (X0.x4 + 0.5 * k[2][4]) - w2*w2 * (X0.x3 + 0.5 * k[2][3]));

k[4,1] := h * (X0.x2 + k[3][2]);
k[4,2] := h * (-r1 * (X0.x2 + k[3][2] - X0.x4 - k[3][4]) -
w1*w1 * (X0.x1 + k[3][1] - X0.x3 - k[3][3]));
k[4,3] := h * (X0.x4 + k[3][4]);
k[4,4] := h * (g * (r1 * (X0.x2 + k[3][2] - X0.x4 - k[3][4]) +
w1*w1 * (X0.x1 + k[3][1] - X0.x3 - k[3][3])) -
r2 * (X0.x4 + k[3][4]) - w2*w2 * (X0.x3 + k[3][3]));
end
else
begin
k[1][1] := h * X0.x2;
k[1][2] := h * (-r1 * (X0.x2 - X0.x4) - w1*w1 * (X0.x1 - X0.x3));
k[1][3] := h * X0.x4;
k[1][4] := h * (g * (r1 * (X0.x2 - X0.x4) + w1*w1 * (X0.x1 - X0.x3)) -
r2 * X0.x4 - w2*w2 * X0.x3);

k[2][1] := h * (X0.x2 + 0.5 * k[1][2]);
k[2][2] := h * (-r1 * (X0.x2 + 0.5 * k[1][2] - X0.x4 - 0.5 * k[1][4]) -
w1*w1 * (X0.x1 + 0.5 * k[1][1] - X0.x3 - 0.5 * k[1][3]));
k[2][3] := h * (X0.x4 + 0.5 * k[1][4]);
k[2][4] := h * (g * (r1 * (X0.x2 + 0.5 * k[1][2] - X0.x4 - 0.5 * k[1][4]) +
w1*w1 * (X0.x1 + 0.5 * k[1][1] - X0.x3 - 0.5 * k[1][3])) -
r2 * (X0.x4 + 0.5 * k[1][4]) - w2*w2 * (X0.x3 + 0.5 * k[1][3]));

k[3][1] := h * (X0.x2 + 0.5 * k[2][2]);
k[3][2] := h * (-r1 * (X0.x2 + 0.5 * k[2][2] - X0.x4 - 0.5 * k[2][4]) -
w1*w1 * (X0.x1 + 0.5 * k[2][1] - X0.x3 - 0.5 * k[2][3]));
k[3][3] := h * (X0.x4 + 0.5 * k[2][4]);
k[3][4] := h * (g * (r1 * (X0.x2 + 0.5 * k[2][2] - X0.x4 - 0.5 * k[2][4]) +
w1*w1 * (X0.x1 + 0.5 * k[2][1] - X0.x3 - 0.5 * k[2][3])) -
r2 * (X0.x4 + 0.5 * k[2][4]) - w2*w2 * (X0.x3 + 0.5 * k[2][3]));

k[4][1] := h * (X0.x2 + k[3][2]);
k[4][2] := h * (-r1 * (X0.x2 + k[3][2] - X0.x4 - k[3][4]) -
w1*w1 * (X0.x1 + k[3][1] - X0.x3 - k[3][3]));
k[4][3] := h * (X0.x4 + k[3][4]);
k[4][4] := h * (g * (r1 * (X0.x2 + k[3][2] - X0.x4 - k[3][4]) +
w1*w1 * (X0.x1 + k[3][1] - X0.x3 - k[3][3])) -
r2 * (X0.x4 + k[3][4]) - w2*w2 * (X0.x3 + k[3][3]));
end;
X0.x1 := X0.x1 + ( k[1,1] + 2*k[2,1] + 2*k[3,1] + k[4,1] ) / 6;
X0.x2 := X0.x2 + ( k[1,2] + 2*k[2,2] + 2*k[3,2] + k[4,2] ) / 6;
X0.x3 := X0.x3 + ( k[1,3] + 2*k[2,3] + 2*k[3,3] + k[4,3] ) / 6;
X0.x4 := X0.x4 + ( k[1,4] + 2*k[2,4] + 2*k[3,4] + k[4,4] ) / 6;
X0.t := t;
Size := Size + 1;
SetLength(Values,Size);
Values[Size-1] := X0;
end;

constructor TRunge.Create(m1 : Double; m2 : Double; c1 : Double;c2 : Double;k1 : Double;k2 : Double;x01 : Double;x02 : Double;x03 : Double;x04 : Double;h : Double;T : Double;q : Double;wq : Double);
begin
self.m1 := m1;
self.m2 := m2;
self.c1 := c1;
self.c2 := c2;
self.k1 := k1;
self.k2 := k2;
self.X0.x1 := x01;
self.X0.x2 := x02;
self.X0.x3 := x03;
self.X0.x4 := x04;
self.h := h;
self.T := T;
self.q := q;
self.Wq := wq;
Self.w1 := sqrt(c1/m1);
Self.w2 := sqrt(c2/m2);
Self.r1 := k1/m1;
Self.r2 := k2/m2;
Self.g := m1/m2;
Size := 0;
end;

procedure TRunge.Run(mode :Boolean);
var
tt,q: Double;
begin
tt := 0;
q := self.q;
while tt<=self.T do
begin
Step(mode,tt,q);
q := self.q * sin(wq*tt);
tt := tt + h;
end;
end;

end.