Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
13
Добавлен:
17.04.2013
Размер:
3.2 Кб
Скачать
Program XXX;
{51875}
Uses CRT,DOS;
Var
D,I,II,III,J,JJ:Integer;
T,TK,TA,TT,
KP,KI,T1,T2,K,DY,S1,S2,S3:Real;
TF,GF,EF,YF,UF:Array[0..510] Of Real;
FF:File Of Real;
G,Y,E,U:Real;

Procedure UY;
Var
UC,T,P:Byte;
UI:Integer;
Begin
UI:=ROUND(U*128+128);
If UI<0 Then UI:=0;
If (UI>255) Then UI:=255;
T:=UI;
Asm
CLI;
End;
Repeat
P:=Port[$31E];
Until P=127;
Port[$31F]:=T;
UC:=Port[$31F];
Asm
STI
End;
Y:=(UC-128)/128-0.5;
End;

Procedure TTT;
Begin
Writeln(' T G E U Y');
For II:=0 To 20 Do
Begin
I:=II*25;
Writeln(' ',TF[I]:7:3,GF[I]:11:3,EF[I]:11:3,UF[I]:11:3,YF[I]:11:3);
End;
Readln;
End;


Begin
TEXTATTR:=58;
CLRSCR;
Repeat
TEXTATTR:=111;
CLRSCR;
For I:=1 To 10 Do Writeln(' ');
Writeln(' 1.ЊЋ„…‹€ђЋ‚ЂЌ€….');
Writeln(' 2.ЉЋЊЏ…Ќ‘Ђ–€џ €Ќ’…ѓђ€ђ“ћ™…ѓЋ ќ‹…Њ…Ќ’Ђ .');
Writeln(' 3.€„…Ќ’€”€ЉЂ–€џ .');
Writeln(' 4.‡ЂЏ€‘њ ');
Writeln(' 5.—’…Ќ€… ');
Write(' 0.ЉЋЌ…– ђЂЃЋ’›. -------->');
Readln(D);

If D=1 Then
Begin
Write(' KP=');Readln(KP);
Write(' T1=');Readln(T1);
Write(' T2=');Readln(T2);
For I:=0 To 500 Do
Begin
YF[I]:=KP*(1 - T1*EXP(-0.1*I/T1)/(T1-T2) + T2*EXP(-0.1*I/T2)/(T1-T2));
TF[I]:=I*0.1;
End;
TTT;
End;

If D=2 Then
Begin
TK:=TF[2]-TF[1];
KI:=(YF[499]-YF[498])/TK;
Writeln(' KI=',KI:7:3);
For I:=0 To 500 Do YF[I]:=YF[I]-YF[1]-KI*I*TK;
TTT;
End;

If D=3 Then
Begin
TEXTATTR:=111;
CLRSCR;
TK:=TF[2]-TF[1];
S1:=TK*0.5;
K:=(YF[498]+YF[499]+YF[500])/3;
For I:=1 To 500 Do
Begin
YF[I]:=YF[I]/K;
S1:=S1+TK*(1-YF[I]);
End;
TTT;
If ABS(S1)<0.0000001 Then S1:=0.0000001;
TA:=TK/S1;
S2:=TA*S1*S1*0.5;
S3:=TA*S1*S1*S1*0.5;
For I:=1 To 500 Do
Begin
TT:=I*TA;
DY:=1-YF[I];
S2:=S2+TA*S1*S1*DY*(1-TT);
S3:=S3+TA*S1*S1*S1*DY*(1-2*TT+0.5*TT*TT);
UF[I]:=S3;
End;
Writeln(' KP=',K:6:3,' TK=',TK:6:3,' S1=',S1:6:3,' S2=',S2:6:3,' S3=',S3:6:3);
Readln;

End;

If D=4 Then
Begin
Assign(FF,'RA.DAT');
Rewrite(FF);
For I:=0 To 500 Do
Begin
Write(FF,TF[I]);
Write(FF,GF[I]);
Write(FF,EF[I]);
Write(FF,UF[I]);
Write(FF,YF[I]);
End;
Close(FF);
End;


If D=5 Then
Begin
Assign(FF,'RA.DAT');
Reset(FF);
I:=0;
{If IORESULT=0 Then }
While Not EOF (FF) Do Begin
Read(FF,TF[I]);
Read(FF,GF[I]);
Read(FF,EF[I]);
Read(FF,UF[I]);
Read(FF,YF[I]);
INC (I);
End;
Close(FF);
TTT;
For I:=480 To 500 Do
Writeln(TF[I]:7:3,GF[I]:11:3,EF[I]:11:3,UF[I]:11:3,YF[I]:11:3);
Readln;
End;

Until D=0;
End.

Соседние файлы в папке curstau