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