Скачиваний:
329
Добавлен:
04.03.2014
Размер:
1 Кб
Скачать
uses crt;
 type ar=array[0..128] of real;
var
   j1,p,h1,delta,j,a,b,h:real;
      n1,n,i:integer;
     y2,y1,y:ar;
function f(x:real):real;
   begin f:=x;
   end;
function pram(h:real;n:integer;yy:ar):real;
 var s:real;
  begin   s:=0;
   for i:=0  to  n-1  do
      s:=s+yy[i];
      pram:=h*s;
  end;
 function smpsn(n:integer ;h:real; y:ar):real;
  var s1,s2:real;  q:integer;
   begin
    s1:=0; s2:=0;  q:=1;
      while q<=(n-1) do begin
      s1:=s1+y[q]; q:=q+2
      end;
      q:=2;
       while q<=(n-2) do begin
       s2:=s2+y[q]; q:=q+2;
       end;
         smpsn:=(y[0]+y[n]+4*s1+2*s2)*h/3;
   end;
 procedure tab(a,h:real;n:integer;var yy:ar);
  var x:real;
   begin
     x:=a;
       for i:=0  to n do
         begin
         yy[i]:=f(x);
         x:=x+h;
         end;
   end;
 Begin clrscr;
   write('a = ');readln(a);
   write('b = ');readln(b);
   write('n = ');readln(n);
  h:=(b-a)/n;
   tab(a,h,n,y);
   j:=smpsn(n,h,y);
       h1:=2*h; n1:=n div 2 ;
       tab(a,h1,n1,y1);
       j1:=smpsn(n1,h1,y1);
       delta:=abs(j-j1)/15;
       tab(a+h/2,h,n-1,y2);
       p:=pram(h,n,y2);
   writeln('===============================================================================');
   writeln('j = ',j:2:3);
   writeln('delta = ',delta:2:3);
   writeln('p = ',p:2:3);
 readln;
  end.
Соседние файлы в папке Alex