
metodo de jacobi y gauss-seidel
Publicado por elias (45 intervenciones) el 08/02/2015 23:26:46
Posibilidad de ver implementacion practica en pascal de eso métodos para calcular matrices...gracias
Valora esta pregunta


0
{Mira esta parte}
program calculo_matricial_jacovi;
uses
crt;
const
max = 9;
intentos = 51;
type
matriz = array[1..max,1..max] of real;
arrais = array[1..max] of real;
valormax = 1..max;
var
ma, mc, md, mp : matriz;
ab, aq, ar, ax, ay : arrais;
ri, rn, rj, doferencia : valormax;
ik : 1..intentos;
procedure entrada_datos(var a : matriz; var b : arrais; var n : valormax);
var
ii, jj : valormax;
begin
clrscr;
write(' N. Ecuaciones De 1 A ',max,' : ');
readln(n);
writeln;
for ii := 1 to n do
begin
writeln(' Ecuacion N. ',ii:1);
writeln(' Coeficientes de ..');
for jj := 1 to n do
begin
write(' X ',jj:1,' : ');
readln(a[ii,jj]);
end;
write(' Termino Independiente : ');
readln(b[ii]);
writeln;
end;
end;
procedure preparar_matriz(a : matriz; var c, d : matriz);
var
mw, mv : arrais;
i, j, h : valormax;
begin
for h := 1 to rn - 1 do
if a[h,h] = 0 then
for i := h + 1 to rn do
if a[i,h] <> 0 then
for j := 1 to rn do
begin
mv[j] := a[i,j];
mw[j] := a[h,j];
a[i,j] := mw[j];
a[h,j] := mv[j];
end;
for i := 1 to rn do
for j := 1 to rn do
begin
if i = j then
begin
c[i,i] := 0;
d[i,i] := a[i,i];
end;
if i <> j then
begin
c[i,j] := a[i,j];
d[i,j] := 0;
end;
end;
end;
procedure resultados(s : arrais);
var
z : valormax;
begin
for z := 1 to rn do
writeln(' X ',ri:1,' = ',S[z]:10:3);
writeln;
end;
begin
entrada_datos(ma, ab, rn);
preparar_matriz(ma, mc, md);
ik := 1;
for ri := 1 to rn do
ay[ri] := 1;
writeln(' ***** Los Resultados Son *****');
writeln;
repeat
for ri := 1 to rn do
for rj := 1 to rn do
mp[ri,rj] := - mc[ri,rj] / md[ri,ri];
for ri := 1 to rn do
aq[ri] := 0;
for ri := 1 to rn do
for rj := 1 to rn do
aq[ri] := aq[ri] + mp[ri,rj] * ay[rj];
for ri := 1 to rn do
ar[ri] := ab[ri] / md[ri,ri];
for ri := 1 to rn do
ax[ri] := aq[ri] + ar[ri];
doferencia := 1;
for ri := 1 to rn do
if abs(ax[ri] - ay[ri]) < 0.01 then
doferencia := doferencia + 1;
ay := ax;
writeln(' Iteracion N. : ',ik);
resultados(ax);
ik := ik + 1;
until (ik = intentos) or (doferencia = rn);
writeln;
writeln(' Pulse Una Tecla');
readkey;
end.
{ A qui lo tienes}
program calculo_matricial;
uses
crt;
const
max = 9;
intentos = 51;
type
matriz = array[1..max,1..max] of real;
arrais = array[1..max] of real;
valormax = 1..max;
var
ma, mc, md, mp : matriz;
ab, aq, ar, ax, ay : arrais;
ri, rn, rj, doferencia : valormax;
ik : 1..intentos;
procedure entrada_datos(var a : matriz; var b : arrais; var n : valormax);
var
ii, jj : valormax;
begin
clrscr;
write(' N. Ecuaciones De 1 A ',max,' : ');
readln(n);
writeln;
for ii := 1 to n do
begin
writeln(' Ecuacion N. ',ii:1);
writeln(' Coeficientes de ..');
for jj := 1 to n do
begin
write(' X ',jj:1,' : ');
readln(a[ii,jj]);
end;
write(' Termino Independiente : ');
readln(b[ii]);
writeln;
end;
end;
procedure preparar_matriz(a : matriz; var c, d : matriz);
var
mw, mv : arrais;
i, j, h : valormax;
begin
for h := 1 to rn - 1 do
if a[h,h] = 0 then
for i := h + 1 to rn do
if a[i,h] <> 0 then
for j := 1 to rn do
begin
mv[j] := a[i,j];
mw[j] := a[h,j];
a[i,j] := mw[j];
a[h,j] := mv[j];
end;
for i := 1 to rn do
for j := 1 to rn do
begin
if i = j then
begin
c[i,i] := 0;
d[i,i] := a[i,i];
end;
if i <> j then
begin
c[i,j] := a[i,j];
d[i,j] := 0;
end;
end;
end;
procedure resultados(s : arrais);
var
z : valormax;
begin
for z := 1 to rn do
writeln(' X ',ri:1,' = ',S[z]:10:3);
writeln;
end;
var
cont : integer;
begin
cont := 1;
entrada_datos(ma, ab, rn);
preparar_matriz(ma, mc, md);
ik := 1;
for ri := 1 to rn do
ay[ri] := 1;
writeln(' ***** Los Resultados Son *****');
writeln;
repeat
for ri := 1 to rn do
for rj := 1 to rn do
mp[ri,rj] := - mc[ri,rj] / md[ri,ri];
for ri := 1 to rn do
aq[ri] := 0;
for ri := 1 to rn do
for rj := 1 to rn do
aq[ri] := aq[ri] + mp[ri,rj] * ay[rj];
for ri := 1 to rn do
ar[ri] := ab[ri] / md[ri,ri];
for ri := 1 to rn do
ax[ri] := aq[ri] + ar[ri];
doferencia := 1;
for ri := 1 to rn do
if abs(ax[ri] - ay[ri]) < 0.01 then
doferencia := doferencia + 1;
ay := ax;
writeln(' Iteracion N. : ',ik);
resultados(ax);
cont := cont + 1;
if cont > 8 then
begin
writeln(' Pulse Una Tecla Para Segir');
readkey;
cont := 1;
clrscr;
writeln;
end;
ik := ik + 1;
until (ik = intentos) or (doferencia = rn);
writeln;
writeln(' Pulse Una Tecla');
readkey;
end.
{Esto de gauss}
program metodo_de_gauss;
uses
crt;
const
max = 51;
type
lamatriz = array[1..max,1..max] of real;
contador = 1..max;
nombre = string[50];
var
matriz : lamatriz;
opci, dim : Contador;
determinado : boolean;
procedure presentamatriz(mat : lamatriz);
var
c, d : contador;
begin
for c := 1 to dim do
begin
for d := 1 to dim + 1 do
write(' ',mat[c,d]:0:2);
writeln;
end;
writeln
end;
procedure entravalores(var matr : lamatriz; var di : contador);
var
c, d : contador;
begin
writeln;
write('Introduzca El Tama¤o de la matriz : ');
readln(di);
clrscr;
for c := 1 to di do
for d := 1 to di do
begin
writeln;
write('Introduzca el Valor (',c,',',d,') : ');
readln(matr[c,d]);
clrscr;
end;
for c := 1 to di do
begin
writeln;
write('Introduzca el valor independiente b(',c,') : ');
readln(matr[c,di + 1]);
clrscr
end;
writeln;
writeln('Los Datos Entrados Son Los Siguiente');
writeln;
presentamatriz(matr);
end;
procedure prepararmatriz(var matr : lamatriz; di : integer; var correcto : boolean);
var
pas, c, d : contador;
corre : boolean;
te, aux : real;
begin
for pas := 1 to di do
begin
corre := false;
c := pas;
while (not corre) and (c <= di) do
begin
If abs(matr[c,pas]) > 0.00001 then
corre := true;
c := c + 1;
end;
c := c - 1;
If corre = true then
begin
te := matr[c,pas];
for d := pas to di + 1 do
begin
if c <> pas then
begin
aux := matr[pas,d];
matr[pas,d] := matr[pas,d] / te;
matr[c,d] := aux;
end
else
matr[pas,d] := matr[pas,d] / te;
end;
end;
for c := pas + 1 to di do
begin
aux := matr[c,pas];
for d := pas to di + 1 do
matr[c,d] := matr[c,d] - aux * matr[pas,d];
end;
end;
correcto := true;
writeln(' *** Los Resultados Son ***');
writeln;
for c := 1 to di do
if abs(matr[c,c]) < 0.00001 then
correcto := false;
if correcto = true then
begin
presentamatriz(matr);
for pas := di downto 1 do
begin
te := matr[pas,pas];
matr[pas,pas] := 1;
matr[pas,di + 1] := matr[pas,di + 1] / te;
for c := pas - 1 downto 1 do
begin
aux := matr[c,pas];
matr[c,pas] := 0;
matr[c,di + 1] := matr[c,di + 1] - matr[pas,di + 1] * aux;
end;
end;
presentamatriz(matr);
end;
end;
procedure presenta_operacion(matr : lamatriz);
var
c : contador;
begin
writeln('Las Operaciones Son');
writeln;
for c := 1 to dim do
writeln(' Matriz ',c,' = ',matr[c,dim + 1]:0:10);
end;
begin
clrscr;
writeln;
writeln(' ***** Metodo De Gauss *****');
writeln;
entravalores(matriz,dim);
writeln;
prepararmatriz(matriz,dim,determinado);
writeln;
If determinado = true then
begin
presenta_operacion(matriz);
end;
readkey;
end.