Курсовые / curstau / IIIR

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.