Скачиваний:
329
Добавлен:
04.03.2014
Размер:
3 Кб
Скачать
Program Chislennoe_Integrirovanye;
 Uses Crt;
 Type
  ar = Array[0..128] of Real;
 Var
  y: ar;
in1,in2,h1,sm,h,s2,del: Real; {­Ё¦­Ё©, ўҐае­Ё© ЇаҐ¤Ґ«л Ё и Ј Ё­вҐЈаЁа®ў ­Ёп}
  a,b,n: Integer;  {зЁб«® а §ЎЁҐ­Ё©}
 p: Real; {Ї®ЈаҐи­®бвм ўлзЁб«Ґ­Ёп}
 {-----------------------------}
 Function F(x: Real): Real;
  Begin
   F:= x*x*x;
  End;
 {-----------------------------}
 Procedure Tab(h: Real; a,n: Integer; Var y: ar);
  Var
   i: Integer;
  Begin
   For i:= 0 To n Do y[i]:= F(a + i*h);
  End;
 {-----------------------------}
 Function Simpson(n: Integer; h: Real; y: ar;var s2:real): Real;
  Var
   i: Integer;
   s1,s3: Real;
  Begin
   s1:= 0;
   i:= 1;
   While i <= (n-1) Do
    Begin
     s1:= s1 + y[i];
     i:= i + 2;
    End;
   s3:= 0;
   i:= 2;
   While i <= (n-2) Do
    Begin
     s3:= s3 + y[i];
     i:= i + 2;
    End;
   Simpson:= (y[0] + y[n] + 4*s1 + 2*s3)*h/3;s1:=0;
   for i:=0 to n-1 do begin s1:=s1+f(a+h/2+i*h);end;
   s2:=h*s1;

  End;
 {-----------------------------}
 Procedure Nachalo(var a,b,n:integer);
  Begin
   Writeln(' ‚ўҐ¤ЁвҐ ЇаҐ¤Ґ«л Ё­вҐЈаЁа®ў ­Ёп: ');
   Write('a = ');
   Readln(a);
   Write('b = ');
   Readln(b);
   write('а §ЎЁҐ­Ёп ?');readln(n);
  End;
 {-----------------------------}
 Procedure TaskB;
  Var
   I1,I2,delta,p: Real;
   flag: Boolean;
  Begin
  write('Ї®ЈаҐи­®бвм ?');readln(p);
   h:= Sqrt(Sqrt(p));
   n:= Round((b-a)/h);
   If Odd(n) Then Inc(n);
   I1:= F((b - a)/2)*(b - a);
   flag:= true;
   While flag Do
    Begin
     h:= (b - a)/n;
     Tab(h,a,n,y);
     I2:= Simpson(n,h,y,s2);
     delta:= Abs(I2 - I1)/15;
     If delta > p
      Then
       Begin
        n:= 2*n;
        I1:= I2;
       End
      Else flag:= false;
    End;
   Write(' зЁб«® а §ЎЁҐ­Ё© - n =',n:3);
   Writeln(' €­вҐЈа « I =',I2:7:5);
   Write('Џ®ЈаҐи­®бвм - delta =',delta:7:5);
  End;
 {-----------------------------}
 Procedure Escape;
  Begin
   TextBackGround(Red);
   TextColor(Yellow);
   GotoXY(1,25);
   WriteLn;
   GotoXY(27,25);
   Write(' „«п ўл室  ­ ¦¬ЁвҐ Esc...');
   Repeat
   Until ReadKey = #27;
   TextBackGround(Black);
   ClrScr;
   TextColor(White);
  End;
 {-----------------------------}
 Begin
  Nachalo(a,b,n);h:=(b-a)/n;tab(h,a,n,y);
 sm:=simpson(n,h,y,s2);writeln('бЁ¬Їб®­:',sm);writeln('ЇаאַгЈ.',s2);h1:=2*h;
 in1:=sm;in2:=simpson(n,h1,y,s2);
 del:=abs(in1-in2)/15;
 writeln('Ї®ЈаҐи­®бвм бЁ¬Їб®­ -',del:8:5);
  TaskB;
  Escape;
 End.
Соседние файлы в папке Alex