1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code]. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
Доброго времени суток. Сижу делаю лабы. Возникли вопросы. 1).
Const n = 3; { Порядок системы уравнений } m = 200; { Допустимое число итераций } Type row = Array [1 .. n] Of real; matrix = Array[1 .. n] Of row;
{ Исходные данные: матрицы A и B (свободные члены) } Const A: matrix = ((0.75, -1.24, 1.56), (-1.24, 0.18, -1.72), (1.56, -1.72 ,0.79));
B: row = (0.49, -0.57, 1.03);
Var X: row; { Вектор решения для текущей итерации } i, j: word; S, Tolerance: real;
Procedure Seidel(Var A: matrix; Var B, X: row; n, m: word; Tolerance: real); Var Y: row; { Вектор решения для предыдущей итерации } T: real; i, j, l: word;
Tolerance_stop_flag: boolean; Const k: word = 0; Iteration_stop_flag: boolean = false; Begin For i := 1 To n Do Begin Y[i] := 0; X[i] := 0 End;
Repeat k := k + 1; For i := 1 To n Do Begin If A[i, i] = 0 Then Begin l := i; Repeat l := l + 1; If (A[l, i] = 0) and (l = n) Then Begin WriteLn('Mistake of reduction of system for ', i, 'equation!'); Halt End Until A[l, i] <> 0; T := B[i]; B[i] := B[l]; B[l] := T;
For j := 1 To n Do Begin T := A[i, j]; A[i, j] := A[l, j]; A[l, j] := T End; WriteLn(i, 'and ', l, ' equations of system are rearranged !') End;
S := 0; For j := 1 To n Do If j <> i Then S := S + A[i, j] * X[j]; X[i] := (B[i] - S) / A[i, i] End;
i := 1; Tolerance_stop_flag := False; Repeat If Abs(X[i] - Y[i]) > Tolerance Then Tolerance_stop_flag := True Else i := i + 1 Until (i = n) or Tolerance_stop_flag;
If not Tolerance_stop_flag Then Begin Iteration_stop_flag := True; Writeln('Number of iterations: ', k) End Else For i := 1 To n Do Y[i] := X[i] Until (k = m) or Iteration_stop_flag;
If not Iteration_stop_flag Then WriteLn('The given number of iterations achieved! ', m) End; {Seidel}
begin WriteLn('Метод Зейделя'); WriteLn('A', 'B': 22);
For i := 1 To n Do Begin For j := 1 To n Do Write(A[i, j]:4 :0); WriteLn(B[i]:10 :0) End; Repeat Write('Допустимая точность решения? '); ReadLn(Tolerance) Until (Tolerance > 0) and (Tolerance < 1);
Seidel(A, B, X, n, m, Tolerance);
WriteLn('Result vector X ', 'Error B-AX': 25); For i := 1 To n Do Begin S := 0; For j := 1 To n Do S := S + A[i, j] * X[j]; WriteLn(X[i]:15:8, '':13, (B[i]-S):15 :8) End; ReadLn end.
Почему при подсчетах выдает ошибку поинт флоатинг операшн? п.с. Код взяла написанный ув. Volvo. Вопрос номер два. Программа Метод Жордана Гаусса
uses crt; program solvgj2;
const maxr = 8; maxc = 8;
type ary = array[1..maxr] of real; arys = array[1..maxc] of real; ary2s = array[1..maxr,1..maxc] of real;
ary2 = ary2s; var y : ary; coef,yy : arys; a,b : ary2s; n,m,i,j : integer; first, error : boolean;
external procedure cls;
procedure get_data(var a: ary2s; var y: ary; var n,m: integer);
var i,j : integer;
begin writeln; repeat write('How many unknowns? '); readln(m); if first then first:=false else cls; until m<maxc; if m>1 then begin repeat write('How many equations? '); readln(n) until n>=m; for i:=1 to n do begin writeln('Equation',i:3); for j:=1 to m do begin write(j:3,':'); read(a[i,j]) end; write(',C:'); readln(y[i]) { clear line } end; { i-loop } writeln; for i:=1 to n do begin for j:=1 to m do write(a[i,j]:7:4,' '); writeln(':',y[i]:7:4) end; writeln end { if n>1 } end; { procedure get_data }
procedure write_data;
var i : integer;
begin for i:=1 to m do write(coef[i]:9:5); writeln end; { write_data }
{external procedure square ( y : ary; var a : ary2s; var g : arys; nrow,ncol : integer);}
begin { MAIN program } first:=true; cls; writeln; writeln('Best fit to simultaneous equations'); writeln('By Gauss-Jordan'); repeat get_data(a,y,n,m); if m>1 then begin square(a,y,b,yy,n,m); gaussj(b,yy,coef,m,error); if not error then write_data end until m<2 end.
Выдает ошибку на external procedure cls; и если убрать строку ( алгоритм рвется) но пишет что не хватает Begin. Помогите пожалуйсто.