Численные методы в программировании

[Loreen]

Задача следующая: Составить таблицу вторых производных с помощью интерполяционного многочлена второй степени
Проблема: Программа запускается, но 'вылетает'. Возможно, неправильная формула второй производной L"(2)

program Project2;
 
{$APPTYPE CONSOLE}
 
uses
  Windows, SysUtils;
 
type
  TArray = array[0..100] of Real;
 
var
  file_name : String;
  N,k : Integer;
  x, y: TArray;
  m: real;
 
 
  procedure screensaver;
  begin
    Writeln('             Задание №1');
    Writeln('      Выполнила: ....... ');
    Writeln('      Проверила: ........');
    writeln('_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ ');
    Writeln;
    Writeln;
    writeln
  end;
 
 procedure Read_file(var file_name : String);
 var
   i,j: Integer;
   f: Text;
 begin
   AssignFile(f, file_name);
   Reset(f);
   Read(f, N);
   WriteLn('Размерность таблицы:   ', n);
   WriteLn('Массив X[i]:');
   for i := 0 to N-1 do
    begin
      Read(f, x[i]);
      WriteLn(x[i]:3:4);
    end;
   writeln('');
   WriteLn('Вектор значений функции:');
   for j := 0 to N-1 do
    begin
      Read(f, y[j]);
      WriteLn(y[j]:3:4)
    end;
  CloseFile(f);
 end;
 
 function Increase(x:TArray):Boolean; //проверка на возрастание
 var
  i:Integer;
  t:Boolean;
 begin
  i:=0;
  t:=True;
  while (i<(N-1)) and t do
   begin
     t := x[i]<x[i + 1];
     inc(i);
   end;
  Result:=t;
 end;
 
  function check(n:integer):boolean;     //  проверка на n
  begin
    if n<1 then check:=false else check:=true;
 end;
 
  function checkerror(x:TArray; n:integer):Integer;
  var IER:integer;
  begin
    if increase(x) and check(n) then IER:=0
            else
    if not increase(x) then IER:=1
            else
    if not check(n) then IER:=2;
  checkerror:=IER;
 end;
 
  procedure outputerror(x:TArray; n:integer); //определение кода ошибки
  var i,k:Integer;
     f:Text;
  begin
    Assignfile(f,'Output.txt');
    Rewrite(f);
    k:=checkerror(x,n);
    if k=1 then Writeln(f,'IER=',k,' нарушен порядок возрастания!');
    if k=2 then Writeln(f,'IER=',k,' N<1!!!');
    Close(f)
  end;
 
 procedure output(x:TArray); //вывод результата в файл
 var i,k:Integer;
     f:Text;
     m:tarray;
 begin
   Assignfile(f,'Output.txt');
   Rewrite(f);
   k:=checkerror(x,n);
   if k=0 then
          begin
           Writeln(f,'Размерность матрицы: ',n);
           m[0]:=(y[0]*(2*x[0]-x[1]-x[2])/(x[0]-x[1])/(x[0]-x[2]))+
            (y[1]*(x[0]-x[2])/(x[1]-x[0])/(x[1]-x[2]))+
            (y[2]*(x[0]-x[1])/(x[2]-x[1])/(x[2]-x[0]));
           for i:=1 to n-2 do
          m[i]:=2*((y[i-1]/  (2*x[i-1]-x[i+1]-x[i]) )
               +   (y[i]  / (2*x[i]-x[i+1]-x[i-1])  )
               +   (y[i+1] / (2*x[i+1]-x[i]-x[i-1]) ));
           m[n-1]:=(y[n-1]*(2*x[n-1]-x[n-2]-x[n-3])/(x[n-1]-x[n-2])/(x[n-1]-x[n-3]))+
            (y[n-2]*(x[n-1]-x[n-3])/(x[n-2]-x[n-1])/(x[n-2]-x[n-3]))+
            (y[n-3]*(x[n-1]-x[n-2])/(x[n-3]-x[n-1])/(x[n-3]-x[n-2]));
            writeln (f,'___________________________________________');
           writeln (f,'    x          y         2-ая производная   ');
           writeln (f,'____________________________________________');
           for i:=0 to n-1 do
           writeln(f,x[i]:3:4,'     ',y[i]:3:4,'     ',m[i]:3:4);
           Writeln(f,'IER=',k,' ошибок нет!');
         end;
  Close(f)
 end;
 
  procedure record_file;
  var s:string;
      f1:text;
  begin
    AssignFile(f1, 'Output.txt');
    reset(f1);
    while not eof(f1) do
    begin
     readln(f1,s);
     writeln(s);
    end;
  end;
//---------------------------------------
begin
  SetConsoleOutputCP(1251);
  SetConsoleCP(1251);
  writeln ('_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _');
  screensaver;
  WriteLn('Введите имя файла:');
  ReadLn(file_name);
  file_name := file_name + '.txt';
  if FileExists(file_name) then
                           begin
                             writeln('');
                             writeln('Исходные данные:');
                             writeln('---------');
                             Read_file(file_name);
                             k:=checkerror(x,n);
                             writeln(' ');
 
                             if k=0 then output(x) else
                                           begin
                                             Writeln('Аварийный выход!Ошибка в исходных данных!');
                                             outputerror(x,n);
                                           end;
                                           writeln('Результат:');
                                           writeln('---------');
                                           record_file
                                           end
                           else Writeln('Такой файл не найден!');
  ReadLn;
end.