Ola, eu sou pessima em programação e não estou conseguindo terminar meu trabalho se alguém puder meajudar desde já agradeço, é que meu programa tá cheio de erro e não estou conseguindo resolvê-los.
O programa é sobre solução de equações lineares. não se assustem com o tamanho, aqui etá ele:
program equacoes_lineares;
const
ordem=3;
type
vetor_real=array[1..ordem] of real;
matriz=array[1..ordem,1..ordem] of real;
var
i,j,k,n:integer;
s:real;
bb:vetor_real;
maior:real;
coef_a:matriz;
mat1:matriz;
resp:vetor_real;
x:vetor_real;
coef_b:vetor_real;
erro:real;
nit:integer;
contr:boolean;
sair:boolean;
opsair:integer;
procedure le_coeficientes;
begin
for i:=1 to ordem do
begin
for j:=1 to ordem do
begin
write('Digite a',i,j ,':');
readln(coef_a[i,j]);
end;
write('Digite o Coeficiente b',i,':');
readln(coef_b[i]);
end;
end;
procedure exibe_matriz;
begin
writeln(' ');
write('Matriz de Coeficientes');
writeln(' ');
for i:=1 to ordem do
begin
writeln(' ');
for j:=1 to ordem do
begin
write(' ',coef_a[i,j]);
end;
end;
writeln(' ');
end;
procedure exibe_resultado;
begin
writeln(' ');
writeln('Vetor de Resultados');
writeln(' ');
for i:=1 to ordem do
begin
writeln(' ');
writeln('Variável x',i,':',x[i]:6:8);
end;
writeln('Número de interações necessárias: ',nit);
end;
procedure inicializa;
begin
erro:=0;
for i:=1 to ordem do
begin
resp[i]:=0;
x[i]:=0;
end;
end;
procedure convergencia;
begin
maior:=-1;
for i:=1 to n do
bb[i]:=1;
for i:=1 to n do
begin
s:=0;
for j:=1 to n do
if i<>j then
s:=abs(coef_a[i,j])*bb[j]+s
else
s:=s+0;
bb[i]:=s/coef_a[i,i];
if bb[i]>maior then
maior:=bb[i];
end;
end;
procedure calcule_erro;
var v_erros: array[1..ordem] of real;
cont:integer;
begin
for cont:=1 to ordem do
v_erros[cont]:= abs (x[cont] - resp[cont]);
erro:= v_erros[1];
for cont:=2 to ordem do
begin
if (v_erros[cont]) > (v_erros[cont - 1]) then
erro:=v_erros[cont];
end;
end;
procedure pivo_parcial(var mat1:matriz;ordem:integer);
var i,j,h : integer;
aux1,aux2:real;
begin
{ pivotamento parcial}
for i:=1 to ordem do
begin
for j:= 1 to ordem do
write(mat1[i,j],' ');
end; readln;
for h:=1 to ordem do
for k:=1 to ordem do
for i:=k to ordem do
begin
if abs(mat1[k,k]) < abs(coef_a[i,k]) then
begin
for j:=1 to ordem do
begin{trocando a linha}
aux1:=mat1[k,j];
mat1[k,j]:=mat1[i,j];
mat1[i,j]:=aux1;
end;
aux2:=coef_b[k]; {trocando as cordenadas do vetor constante}
coef_b[k]:=coef_b[i];
coef_b[i]:=aux2;
end;
for i:=1 to ordem do
begin
for j:= 1 to ordem do
write(mat1[i,j],' ');
readln;
end;
end;
end;
procedure metodo_ElmGauss;
var m:real;
begin
nit:=0;
pivo_parcial(mat1,ordem); {chamada de procedimento}
n:=ordem;
for k:=1 to (n) do
begin
for i:=(k+1) to n do
begin
m:=(coef_a[i,k])/(coef_a[k,k]);
coef_a[i,k]:=0; {fazendo o elemento ser zero}
for j:=(k+1) to n do
begin
coef_a[i,j]:=(coef_a[i,j]) - (m*coef_a[k,j]);
end;
coef_b[i]:=(coef_b[i])- (m * coef_b[k]);
end;
end;
x[n]:=(coef_b[n]) / (coef_a[n,n]);
for k:=1 to (n-1) do
begin
x[k]:=coef_b[k];
end;
for k:=(n - 1) downto 1 do
begin
for i:=(k+1) to n do
begin
x[k]:=(x[k]) - (coef_a[k,i] * x[i]);
end;
x[k]:=(x[k]) / (coef_a[k,k]);
nit:=nit+1;
end;
end;
procedure metodo_gaussjordan;
var m: real;
begin
nit:=0;
pivo_parcial(mat1,ordem);
n:=ordem;
for k:=1 to (n-1) do
begin
for k:=(k+1) to n do
begin
m:= (coef_a[i,k])/(coef_a[k,k]);
coef_a [i,k]:= 0;
for j:= (k+1) to n do
coef_a[i,j]:=(coef_a[i,j]) - (m * coef_a[k,j]);
end;
coef_b[i]:= (coef_b[i]) - (m * coef_b[k]);
end;
for k:=(n) downto 1 do
begin
for i:=(k-1) downto 1 do
begin
m := (coef_a[i,k])/(coef_a[k,k]);
coef_a[i,k]:= 0;
for j:= n downto 1 do
begin
coef_a[i,j]:= (coef_a[i,j]) -(m*coef_a[k,j]);
end;
coef_b[i]:= (coef_b[i]) - (m*coef_b[k]);
end;
end;
coef_b[n]:= (coef_b[n]) / (coef_a[n,n]);
coef_a[n,n]:=1;
x[n]:= coef_b[n];
nit:=nit+1;
end;
procedure metodo_Jacobi;
var
i,j :integer;
begin
nit:=0;
erro:=4;
convergencia;writeln(maior);readln;
if (maior > 1)
then write ('O sistema nao converge pois b=',maior:0:8)
else begin
writeln('o sistema converge pois b=', maior:5:8);
while (erro > 0.000001) or (nit < 100) do
begin
for i:= 1 to ordem do
begin
for j:= 1 to ordem do
begin
if i<>j then
resp[i]:=(coef_a[i,j]* x[j])+resp[i];
end;
resp[i]:=(coef_b[i]-resp[i])/ (coef_a[i,i]);
end;
calcule_erro;
for i:=1 to ordem do
begin
x[i]:= resp[i];
resp[i]:=0;
nit:=nit+1;
end;
end;
end;
end;
procedure metodo_gaussseidel;
var
i,j : integer;
begin
nit:=0 ;
erro:=5;
convergencia;
if (maior < 1) then
begin
writeln('O Sistema converge, pois b= ',maior:5:8,'.');
if (maior > 1 ) then
begin
writeln('O Sistema nao converge, pois b= ',maior:5:8,'.');
end;
end;
while (erro>0.000001) or (nit < 100) do
begin
for i:= 1 to ordem do
begin
for j:= 1 to ordem do
begin
if j<i then
resp[i]:= (coef_a[i,j]*resp[j])+(resp[i]);
if j>i then
resp[i]:= (coef_a[i,j]*x[j])+(resp[i]);
end;
resp[i]:= (coef_b[i]-resp[i])/(coef_a[i,i]);
end;
calcule_erro;
for i:=1 to ordem do
begin
x[i]:= resp[i];
resp[i]:=0;
nit:=nit+1;
end;
end;
end;
procedure menu_metodos;
var
opcao_b: integer;
contr_b: boolean;
begin
le_coeficientes;
exibe_matriz;
writeln(' ');
writeln('RESOLUCAO DE SISTEMAS DE EQUACOES LINEARES');
writeln(' ');
writeln('METODOS:');
writeln(' ');
writeln('1 - Metodo de Eliminacao de Gauss');
writeln('2 - Metodo Gauss-Jordan');
writeln('3 - Metodo de Jacobi');
writeln('4 - metodo de Gauss Seidel');
writeln(' ');
contr_b:=false;
while contr_b=false do
begin
write('METODO ESCOLHIDO');
readln(opcao_b);
case opcao_b of
1:begin
metodo_ElmGauss;
contr_b:=true;
end;
2:begin
metodo_GaussJordan;
contr_b:=true;
end;
3:begin
metodo_Jacobi;
contr_b:=true;
end;
4:begin
metodo_gaussseidel;
contr_b:=true;
end;
else
contr_b:=false;
end
end;
end;
begin
repeat
inicializa;
menu_metodos;
exibe_resultado;
contr:=false;
while contr=false do
begin
writeln('1 - exeutar novamente');
writeln('2 - sair');
write('opcao');
readln(opsair);
case opsair of
1:begin
sair:=true;
contr:=true;
end;
2:begin
sair:=false;
contr:=true;
end;
else
contr:=false;
end;
end;
until sair=false;
end.



Responder com Citação

