old/PAS/!SPbSTU/Razzario/INTEGRAL.PAS

Uses CRt;
CONST
  minX          = 59.0;
  maxX          = 62.0;
  LenX          = maxX-minX;
  Eps   : real  = 0.00001;
{---------------------------------------------------------------}
VAR
   Value                : real;
   Ntr                  : longint;
{---------------------------------------------------------------}
Function F_X(X:real):real;
begin
{  F_X := sqrt(X)*(x);}
{   F_X := sqrt(40000-x*x);}
  F_X := sin(49*x*PI/180)*cos(12.5*x*PI/180)+1;
{  F_X := sin(X)*cos(X*PI/180)+1;}
{   F_X := 1/x+1;}
end;{F_X}
{---------------------------------------------------------------}
Procedure LeftPram;
var
  LastVal : real;
  i       : longint;
  y       : real;
begin
  Ntr   := 1;
  repeat
   LastVal := Value;
   Value   := 0;
   for i := 0 to Ntr-1 do
    begin
      y := F_X(lenX*i/Ntr + minX);
      Value := Value + y*lenX/Ntr;
    end;
    Ntr:=Ntr shl 1;
  until abs(Value-LastVal) < Eps;
end;{LeftPram}
{--------------------------------------------------------------}
Procedure CenterPram;
var
  LastVal : real;
  i       : longint;
  y       : real;
begin
  Ntr   := 1;
  repeat
   LastVal := Value;
   Value   := 0;
   for i := 0 to Ntr-1 do
    begin
      y := F_X(lenX*i/Ntr + minX + lenX/Ntr/2);
      Value := Value + y*lenX/Ntr;
    end;
    Ntr:=Ntr shl 1;
  until abs(Value-LastVal) < Eps;
end;{CenterPram}
{--------------------------------------------------------------}
Procedure RightPram;
var
  LastVal : real;
  i       : longint;
  y       : real;
begin
  Ntr   := 1;
  repeat
   LastVal := Value;
   Value   := 0;
   for i := 1 to Ntr do
    begin
      y := F_X(lenX*i/Ntr + minX);
      Value := Value + y*lenX/Ntr;
    end;
    Ntr:=Ntr shl 1;
  until abs(Value-LastVal) < Eps;
end;{RightPram}
{--------------------------------------------------------------}
Procedure CalcTrap;
var
  LastVal : real;
  i       : longint;
  y1,y2   : real;
begin
  Ntr    := 1;
  repeat
   LastVal := Value;
   Value   := 0;
   for i := 1 to Ntr do
    begin
      y1 := F_X((lenX*(i-1))/Ntr + minX);
      y2 := F_X( lenX* i    /Ntr + minX);
      Value := Value + ((y1+y2)/2)*(lenX/Ntr);
    end;
    Ntr:=Ntr shl 1;
  until abs(Value-LastVal) < Eps;
end;{CalcTrap}
{--------------------------------------------------------------}
VAR
   mode : byte;
BEGIN
 mode:=0;
  WriteLn('Выберите метод интегрирования:');
  WriteLn('  1: Левосторонних  прямоугольников');
  WriteLn('  2: Центральных  прямоугольников');
  WriteLn('  3: Правосторонних прямоугольноков');
  WriteLn('  4: Метод трапеций');
  Write(#13'Нажмите: ');
  while not (mode in [1..4]) do Mode:=Ord(ReadKey)-$30;
  Write(Mode);
  case mode of
   1: LeftPram;
   2: CenterPram;
   3: RightPram;
   4: CalcTrap;
  end;
  WriteLn(#10#13'Интергал: ',Value:0:5);
END.