Оптимальное проектирование технических систем на ЭВМ / Конечные_Системы(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.