unit Diagnoz;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type
MASK = array[1..4096] of real; {X, Y}
MASKCP = array[1..4096] of real;
MASKD = array [1..500] of string;
MAS3 = array[0..50] of real;
MASKDD = array[0..50] of real;
MAS = array[0..20,0..30] of real;
MASK1 = array[0..4096] of integer;
var
S, I, JJ, J, K, MM, MP, M, KNN, KVV, IM, IG, KN, KV, NEIZ : integer;
AX, ASR, XK, F, DT, A : MASK;
SKRAT, FT : MASKCP;
MPP, TEXT : string;
DataFile : file;
AAS, ASI : MAS3;
xx : byte;
X, Y : MASK;
KM, DF, MK, MAXF, SX, SY, KD1, SA, WOB1, WOB, SYGG, YS, YYS, AM : real;
SS : MASKD;
KD : longint;
TPPR, L, FD, ND, TIP: integer;
myfile : textfile;
AS1 : maskdd;
YGG, YSS, YG, FG : MAS;
const jjk = 2; FMAX = 11025/2; N = 12;
Procedure SUMGARM(var AX : mask; KN1, KV1 : integer; SYGG: real);
var S : real;
begin
S := 0;
for i := KN1 to KV1 do
begin
S := S + sqr(AX[i]);
end;
SYGG := sqrt(S);
end;
{Procedure MAXGARM(var P : MASK1; KNN, KVV : integer; var MAXGG : integer);
var
MAXG, MK, MAX : real;
IM: integer;
begin
MK :=P[KNN];
IM := KNN;
MAXG := FMAX*(KM/2)/K*IM;
for i := KNN to KVV do
begin
if P[i] > MK then
begin
MK := P[i];
IM := I;
MAXG := FMAX*(KM/2)/K*IM;
end;
end;
MAXGG := round(MAXG/F[1]);
end; }
Procedure Maxgarm(var P:mask; knn,kvv: integer; var maxgg:integer);
var maxg,mk,max:single;im :integer;
begin
mk:=P[knn];
im:=knn;
maxg:=fmax*(km/2)/k*im;
For i:=knn to kvv do
begin
if p[i]>mk then
begin
mk:=p[i];
Max:=mk;
im:=i;
Maxg:=fmax*(km/2)/k*im;
end; end;
maxgg:=round(maxg/f[1]);
end;
procedure PODSHIPNIK(WOB2 : real; AF : MASKCP; AWOB : real);
Function MAX(P : mask) : real;
begin
KNN := round(0.9 * WOB2 / 60 / F[1]);
KVV := round(1.1 * WOB2 / 60 / F[1]);
MK := P[KNN];
IM := KNN;
MAXF := FMAX * (KM / 2) / K * IM;
for I := KNN to KVV do
begin
if P[i] > MK then
begin
MK := P[i];
MAX := MK;
IM := I;
MAXF := fmax * (KM / 2) / K * IM;
end;
end;
end;
var AM, MAXF : real; IM : integer;
begin
AM := MAX(A);
AWOB := MAXF * 60;
for I := 1 to L do
AF[i] := MAXF * SKRAT[i];
end;
procedure Spektr(var AX, AY; Dim: Word; D: Integer);
var
x: array [1..16384] of real absolute AX;
y: array [1..16384] of real absolute AY;
I, J, N, L, K, LE, LE1,IP, NV2, NM1: Integer;
Arg, U1, U2, U3, C, S, T1, T2, T3, T4: real;
begin
N := 1 shl Dim;
if D = -1 then FillChar(Y, N*SizeOf(real), 0);
for L := 1 to Dim do
begin
LE := 1 shl (Dim+1-L);
LE1 := LE div 2;
U1 := 1;
U2 := 0;
Arg := Pi/LE1;
C := Cos(Arg);
S := D*Sin(Arg);
for J := 1 to LE1 do
begin
I := J;
while I <= N do
begin
IP := I + LE1;
T1 := X[i] + X[IP];
T2 := Y[i] + Y[IP];
T3 := X[i] - X[IP];
T4 := Y[i] - Y[IP];
X[IP] := T3*U1 - T4*U2;
Y[IP] := T4*U1 + T3*U2;
X[i] := T1;
Y[i] := T2;
I := I + LE;
end;
U3 := U1*C - U2*S;
U2 := U2*C + U1*S;
U1 := U3;
end;
end;
NV2 := N div 2;
NM1 := N-1;
J := 1;
for I := 1 to NM1 do
begin
if I < J then
begin
T1 := X[J];
T2 := Y[J];
X[J] := X[i];
Y[J] := Y[i];
X[i] := T1;
Y[i] := T2;
end;
K := NV2;
while K < J do
begin
J := J - K;
K := K div 2;
end;
J := J + K
end;
if D = 1 then Exit;
for I:=1 to N do
begin
X[i] := X[i] / N*2;
Y[i] := Y[i] / N*2;
end;
X[1] := 0;
end;
procedure TForm1.Button1Click(Sender: TObject);
var SO, NOM : string;
ANED : real;
data,datai : array [1..3] of integer;
Asr : array [1..10] of integer;
K : integer;
begin
SO := Edit1.Text;
WOB := StrToInt(Edit2.Text);
TPPR := StrToInt(Edit3.Text);
ANED := StrToFloat(Edit4.Text);
L := StrToInt(Edit5.Text);
FD := StrToInt(Edit6.Text);
ND := StrToInt(Edit7.Text);
TIP := StrToInt(Edit9.Text);
Asr[1] := StrToInt(Edit10.Text);
data[1] := StrToInt(Edit8.Text);
data[2] := StrToInt(Edit11.Text);
data[3] := StrToInt(Edit12.Text);
Label2.Caption := 'Îáúåêò äèàãíîñòèðîâàíèÿ: ' + SO + #13 +
'×èñëî îáîðîòîâ â ìèíóòó: ' + FloatToStr(WOB) + #13 +
'Íàðàáîòêà äî ðåìîíòà ñîñòàâëÿåò: ' + IntToStr(TPPR) + ' äíåé ' + #13 +
'Ïðåäåëüíî äîïóñòèìûé óðîâåíü âèáðàöèé: ' + FloatToStr(ANED) + ' ìì/ñ' + #13 +
'Êîëè÷åñòâî äèàãíîñòèðóåìûõ äåôåêòîâ: ' + IntToStr(L) + #13 +
'×àñòîòà äèàãíîñòèðîâàíèÿ: ' + IntToStr(FD) + ' Ãö' + #13 +
'Êîëè÷åñòâî äàò÷èêîâ: ' + IntToStr(ND) + #13 +
'Äàòà ïðîâåäåíèÿ èñõîäíûõ èçìåðåíèé: ' + IntToStr(data[1]) + '.' + IntToStr(data[2]) +
'.' + IntToStr(data[3]) + #13 +
'Êîëè÷åñòâî çàìåðîâ: ' + IntToStr(TIP) + #13 +
'Ñóììàðíûé óðîâåíü ïî äàò÷èêó (ìì/ñ): ' + IntToStr(Asr[1]);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
DataFile : file;
I, J : Integer;
XX : Byte;
begin
mpp := '1';
ss[kd] := '1w';
AssignFile(DataFile, ss[kd] + mpp + '.wav');
Reset(DataFile, 1);
Seek(DataFile, 50);
AAS[0] := 0;
for I:=1 to K do
begin
A[i] := 0;
end;
for JJ := 1 to jjk do
begin
for J := 1 to 4096 do
begin
BlockRead(DataFile, XX, 1);
X[J] := XX;
end;
MM := round(exp(n*ln(2)));
K := round(mm/2);
DF := round(wob/60*mm/(2*fmax));
KM := wob/60*mm/(fmax*df);
F[1]:=fmax*(km/2)/k;
for I:=1 to K do
begin
XK[i] := X[i];
DT[i] := 1/(KM*FMAX)*I;
end;
for I := 1 to MM do
y[i] := 0;
SPEKTR(X,Y,N, -1);
SX := 0;
SY := 0;
F[1] := FMAX*(KM/2)/K;
for I := 1 to K do
begin
A[i]:=(A[i]*(jj-1)+sqrt(sqr(x[i])+sqr(y[i])))/jj;
SX := SX+(X[i])/round(FD/F[1]);
SY := SY+(Y[i])/round(FD/F[1]);
end;
AAS[jj]:=(AAS[JJ-1]*(JJ-1)+sqrt(sqr(SX)+sqr(SY))*round(FD/F[1]))/JJ;
for I := 1 to K do
F[i] := FMAX*(KM/2)/K;;
end;
CloseFile(DataFile);
ASI[M] := AAS[JJK];
AS1[M] := ASR[KD];
SA := ASI[M];
Label13.Caption := 'MM: ' + IntToStr(MM) + #13 +
'K: ' + IntToStr(K) + #13 +
'DF: ' + FloatToStr(DF) + #13 + 'KM: ' + FloatToStr(KM) + #13 +
'F[1]: ' + FloatToStr(F[1]) + #13 +
'SA = ' + FloatToStr(SA) + #13 +
'ASI[M]= ' + FloatToStr(ASI[M]) + #13 +
'SX: ' + FloatToStr(SX);
PODSHIPNIK(WOB,FT,WOB1);
for j:=1 to L do
begin
kn:=round(0.98*Ft[j]/f[1]);
kv:=round(1.05*Ft[j]/f[1]);
Maxgarm(A,kn,kv,ig);
FG[J,M] := IG * F[1];
KN := round(IG - 3);
KV := round (IG + 3);
SUMGARM(A, KN, KV, SYGG);
YG[j,m] := SYGG;
end;
YS := 0;
for I := 1 to L do
YS := YS + sqr(YG[i,m]);
SA := sqr(SA);
if SA < YS then
SA := 1.05 * YS
else
SA := SA;
YG[L + 1, M] := SQRT(SA - YS);
for I := 1 to L + 1 do
YG[I,M] := YG[I,M] * AS1[M] / sqrt (SA);
for I := 1 to k do
A[i] := A[i] * AS1[M] / sqrt(SA);
YYS := 0;
for J := 1 to L+1 do
begin
YYS := YYS + sqr(YG[J,M]);
end;
YYS := sqrt(YYS);
Label4.Caption := 'KN : ' + IntToStr(KN) + #13 + 'KV: ' + IntToStr(KV) +
#13 + 'F1 := ' + FloatToStr(F[1]) + #13 +
'IG: ' + IntToStr(IG);
{posle korektirovki}
{
Label4.Caption := 'SA = ' + FloatToStr(SA) + #13 +
'YYS= ' + FloatToStr(YYS) + #13 + FloatToStr(YG[1,1]);
}
end;
end.