Скачиваний:
289
Добавлен:
04.03.2014
Размер:
1.08 Кб
Скачать
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