Скачиваний:
289
Добавлен:
04.03.2014
Размер:
3.06 Кб
Скачать
uses crt ;
const n=10;
type
ar1=array[1..n-1] of real;
ar2=array[0..n] of real;
var
a,b,c,f:ar1;
x,y,w,m:ar2;
h,d,dt,k0,kn,p0,pn:real;
i:integer;
function ff(x:real):real;
begin ff:=(x-5)*(x-5)*(x-5)*(x-5)*(x-5); end;
{of ff}
Procedure tab(a,h:real; Var u,v:ar2);
var t:real;
begin t:=a;
for i:=0 to n do
begin u[i]:=t; v[i]:=ff(t); t:=t+h; end;
end;
{of tab}
procedure predat(h:real; y:ar2; Var a,c,b,f:ar1; Var k0,kn,p0,pn:real);
begin
for i:=1 to n-1 do
begin a[i]:=1; b[i]:=1; c[i]:=-4;
f[i]:=3*(y[i+1]-y[i-1])/h;
end;
k0:=0; kn:=0;
p0:=(-11*y[0]+18*y[1]-9*y[2]+2*y[3])/6/h;
pn:=(11*y[n]-18*y[n-1]+9*y[n-2]-2*y[n-3])/6/h;
end;
{of predat}
Procedure prgn(a,c,b,f:ar1; k0,kn,p0,pn:real; Var z:ar2);
var k,p:ar2;
begin
k[0]:=k0; p[0]:=p0; k[n]:=kn; p[n]:=pn;
for i:=1 to n-1 do
begin k[i]:=b[i]/(c[i]-a[i]*k[i-1]); p[i]:=(a[i]*p[i-1]-f[i])/(c[i]-a[i]*k[i-1]);
end;
z[n]:=(p[n]+k[n]*p[n-1])/(1-k[n]*k[n-1]);
for i:=n-1 downto 0 do z[i]:=k[i]*z[i+1]+p[i];
end;
{of prgn}
Function spln3(x,y,m:ar2; h,w:real):real;
label 1;
Var s1,s2,s3,s4:real;
begin
if (w<x[0]) or (w>x[n]) then
write(' ERROR IN INPUT DATE!!!!!!!!!!!!') else begin

i:=0 ;
while w>x[i+1] do i:=i+1;
s1:=sqr(x[i+1]-w)*(2*(w-x[i])+h)*y[i]/h/h/h ;
s2:=sqr(w-x[i])*(2*(x[i+1]-W)+h)*y[i+1]/h/h/h ;
s3:=sqr(x[i+1]-w)*(w-x[i])*m[i]/h/h;
s4:=sqr(w-x[i])*(w-x[i+1])*m[i+1]/h/h;
spln3:=s1+s2+s3+s4; end;
1: end;
{of spln3}
Begin
clrscr;
writeln(' ‚ўҐ¤ЁвҐ ¤ ­­лҐ');
write('a=');readln(d);
write('b='); readln(dt);
h:=(dt-d)/n;
tab(d,h,x,y);
predat(h,y,a,c,b,f,k0,kn,p0,pn);
prgn(a,c,b,f,k0,kn,p0,pn,m);
for i:=0 to n-1 do
begin w[i]:=x[i]+h/2; write(i,':',w[i]:2:3,' spln=',spln3(x,y,m,h,w[i]):2:5);
writeln(' f=',ff(w[i]):2:5);
end;
readln;
End.
Соседние файлы в папке Alex