реализация метода трехточечной прогонки.(прогонка назад)ошибка при записи в файл,задача вылетает в runtime.помогите найти ошибку
Код:
program Project2;
{$APPTYPE CONSOLE}
uses
Windows, SysUtils;
type
TMas = array[0..999] of Real;
var
file_name : String;
n,mn,k : Integer;
a,b,c,y: TMas;
Xx:Real;
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('Элементы поддиагонали');
for i := 0 to n-1 do
begin
Read(f,a[i]);
WriteLn(a[i]:3:4);
end;
WriteLn('Элементы наддиагонали');
for i := 0 to n-1 do
begin
Read(f,b[i]);
WriteLn(b[i]:3:4);
end;
WriteLn('Элементы главной диагонали');
for i := 0 to n-1 do
begin
Read(f,c[i]);
WriteLn(c[i]:3:4);
end;
WriteLn('Значения функции:');
for j := 0 to n-1 do
begin
Read(f, y[j]);
WriteLn(y[j]:3:4)
end;
CloseFile(f);
end;
function checkcondition(a,b,c:TMas):Boolean; //проверка на условие диагонального преобладания
var
i:Integer;
t:Boolean;
begin
i:=0;
t:=true;
while (i<(n-1)) and t do
begin
t:=(abs(c[i])>=(abs(a[i])+abs(b[i])));
inc(i)
end;
Result:=t
end;
//-------------------------------------------------
function check(c:tmas):boolean; // проверка на с
begin
if c[0]=0 then check:=false else check:=true;
end;
//----------------------------------------------------
function checkerror(a,b,c:tmas):Integer; //определение кода ошибки
var IER:integer;
begin
if checkcondition(a,b,c) and check(c) then IER:=0 ;
//else
if not checkcondition(a,b,c) then IER:=2 ;
//else
if not check(c) then IER:=1;
result:=IER;
write(result)
end;
//-----------------------------------------------------
Procedure output(a,b,c,y:TMas); //вывод данных в файл
var i,k:Integer;
f:text;
m,v,x:tmas;
begin
Assignfile(f,'Результат.txt');
Rewrite(f);
k:=checkerror(a,b,c);
if k=0 then
begin
Writeln(f,'Размерность матрицы: ',n);
writeln (f,'a b c y x');
writeln (f,'____________');
m[n-2]:=-a[n-1]/c[n-1];
v[n-2]:=y[n-1]/c[n];
m[n-3]:=-a[n-2]/(b[n-2]*m[n-2]+c[n-1]);
v[n-3]:=(y[n-2]-b[n-2]*v[n-2])/(b[n-2]*m[n-2]+c[n-2]);
x[n-1]:=m[n-2]*x[n-2]+v[n-1];
x[n-2]:=m[n-3]*x[n-3]+v[n-3];
for i:=(n-3) downto 1 do
x[i]:=m[i-2]*x[i-2]+v[i-2];
x[0]:=(y[0]-b[0]*v[0])/(c[0]+b[0]*m[0]);
writeln(f,a[i]:3:4,' ',b[i]:3:4,' ',c[i]:3:4,' ',y[i]:3:4,' ',x[i]:3:4,' ');
Writeln(f,'IER=',k,' ошибок нет!');
end;
Close(f)
end;
//----------------------------------------------------
Procedure outputerror(a,b,c:tmas); //определение кода ошибки
var i,k:Integer;
f1:Text;
begin
Assignfile(f1,'Результат.txt');
Rewrite(f1);
k:=checkerror(a,b,c);
if k=1 then Writeln(f1,'IER=',k,' c[0]=0!');
if k=2 then Writeln(f1,'IER=',k,' не выполнено условие диагонального преобладания');
Close(f1)
end;
//---------------------------------------------
procedure write_file;
var s:string;
f1:text;
begin
AssignFile(f1, 'Результат.txt');
reset(f1);
while not eof(f1) do
begin
readln(f1,s);
writeln(s);
end;
end;
//---------------------------------------
begin
SetConsoleOutputCP(1251);
SetConsoleCP(1251);
WriteLn('Введите имя файла');
ReadLn(file_name);
file_name := file_name + '.txt';
if FileExists(file_name) then
begin
writeln('Исходные данные:');
writeln;
Read_file(file_name);
k:=checkerror(a,b,c);
writeln;
writeln('____________________');
if k=0 then
output(a,b,c,y)
else
begin
Writeln('Ошибка в исходных данных!Аварийный выход!');
outputerror(a,b,c);
end;
writeln('Результат:');
writeln('____________');
write_file
end
else Writeln('Такой файл не найден!');
ReadLn;
end.