01 семестр / К экзамену-зачёту / Все задачи с экзамена в формате PAS / Alex / SPLINE_3

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    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.