Оптимальное проектирование технических систем на ЭВМ / Колебательная_Система(1) / Support

Unit Support;

 Interface

  Uses ComCtrls,SysUtils;

  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;
     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 Raschet(mode: Boolean; progrBar: TProgressBar);
     PROCEDURE Step(mode: Boolean; t,q: Double);
   End;

 Implementation

 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.Raschet(mode :Boolean;progrBar: TProgressBar);
   Var
    tt,q,hh,ss: Double;
  BEGIN
   tt:=0;
   hh:=(self.T-tt)/h;
   hh:=hh/100;
   q:=self.q;
   ss:=0;
   While tt<=self.T Do
    Begin
     Step(mode,tt,q);
     q:=self.q * sin(wq*tt);
     tt:=tt + h;
     ss:=ss+1;
     if ss>=hh then
      begin
        ss:=0;
        progrBar.StepBy(1);
      end;
    End;
  END;

 PROCEDURE TRunge.Step(mode: Boolean; t,q: Double);
   Var
    k: Array [1..4,1..4] Of Double;
  BEGIN
   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;

End.