Скачиваний:
329
Добавлен:
04.03.2014
Размер:
1 Кб
Скачать
uses crt;
type ar=array[0..128] of real;
var delta,j,h,h1,s5,j1,a,b,s,s2,s1:real;y,y1,y2,y3:ar;i,n,n1:integer;
label 1;
function sample(n:integer;h:real;y:ar):real;
var i:integer;s3,s4:real;
begin i:=1;s3:=0;s4:=0;
  while i<=n-1 do begin
   s3:=s3+y[i];i:=i+2;
  end;
  I:=2;
  while i<=n-2 do begin
    s4:=s4+y[i];i:=i+2;
  end;
  sample:=h*(y[0]+y[n]+4*s3+2*s4)/3;
end;
procedure tab(a:real;n:integer;h:real;var yy:ar);
var i:integer;x:real;
begin x:=a;
  for i:=0 to n do begin
    yy[i]:=x*x*x;
    x:=x+h;
  end;
  end;
begin {main} clrscr;
  writeln('enter a,b,n ');readln(a,b,n);
  if odd(n) then begin Writeln('WARNING: incorrect entry');
  n:=n+1;end;
  h:=(b-a)/n;tab(a,n,h,y);j:=sample(n,h,y);
  h1:=h/2;n1:=n*2;
  tab(a,n1,h1,y1);j1:=sample(n1,h1,y1);
  delta:=abs(j-j1)/15;
  writeln('smpsn=',j:2:5,' delta=',delta:2:7);
  tab(a+h/2,n-1,h,y2);tab(a+h1/2,n1-1,h1,y3);s:=0;s5:=0;
  for i:=1 to n do begin
  s:=s+y2[i]*h;s5:=s5+y3[i]*h1;
  end;delta:=abs(s-s5)/3;
  writeln('rectangle I=',s:2:5,' delta=',delta:2:7);
  readln;
end.
Соседние файлы в папке Alex