Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 30.04.2013, 20:31   #1
Вероника92
Пользователь
 
Регистрация: 28.05.2012
Сообщений: 35
По умолчанию решения СЛАУ

реализация метода трехточечной прогонки.(прогонка назад)ошибка при записи в файл,задача вылетает в 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.
Вложения
Тип файла: txt Задание.txt (43 байт, 136 просмотров)
Вероника92 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
С# Решения СЛАУ bestnicer Помощь студентам 2 27.02.2013 16:48
Матричный метод решения СЛАУ EddieG Общие вопросы C/C++ 0 15.12.2011 02:26
Решения СЛАУ методом Гаусса и Зейделя [ICQ] Помощь студентам 0 04.05.2010 20:51
Код в Delphi для решения СЛАУ Marat6233 Помощь студентам 0 14.04.2010 16:54
Продажа программы решения СЛАУ psyco Софт 1 28.02.2010 18:48