Pastebin is 300% more awesome when you are logged in. Sign Up, it's FREE!
Guest

Resolver sistemas lineares

By: a guest on May 25th, 2010  |  syntax: Pascal  |  size: 3.29 KB  |  hits: 143  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
This paste has a previous version, view the difference. Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. Program Sistema_Linear;
  2.  
  3.         type vetor = array[1..20] of extended;
  4.                 matriz = array[1..20,1..20] of extended;
  5.  
  6.         var Constantes: vetor;
  7.                 Mampliada: matriz;
  8.                 Mauxiliar: matriz;
  9.                 Cons_auxiliar: vetor;
  10.                 i, j, N, Num_escolha: integer;
  11.                 Escolha: char;
  12.  
  13. function compara_vetor (Vetora, Vetorb: vetor): extended;
  14.         var Subtrai: vetor;
  15.                 Max: extended;
  16.         begin
  17.                 max := 0;
  18.                 for i := 1 to N do
  19.                         begin
  20.                                 Subtrai[i] := Vetora[i] - Vetorb[i];
  21.                         end;    
  22.                 for i := 1 to N do
  23.                         begin
  24.                                 if abs(Subtrai[i]) > Max then
  25.                                         begin
  26.                                                 Max := abs(Subtrai[i]);
  27.                                         end;
  28.                                 compara_vetor := max;
  29.                         end;
  30.         end;
  31.  
  32. procedure escalona_sup (MatrizA: matriz; Vetorconst: vetor);
  33.        
  34.         var i, j, k: integer;
  35.                 aux: extended;
  36.         begin  
  37.                 for k := 1 to (N - 1) do
  38.                         begin
  39.                                 for j := (k + 1) to N do
  40.                                         begin
  41.                                                 aux := MatrizA[k, j]/MatrizA[j, j];
  42.                                                 for j := (k + 1) to N do
  43.                                                         begin
  44.                                                                 MatrizA[k, i] := MatrizA[k, i] - aux * MatrizA[j, i];
  45.                                                         end;
  46.                                                 Vetorconst[k] := Vetorconst[k] - aux * Vetorconst[j];
  47.                                         end;
  48.                         end;
  49.         end;
  50.  
  51. procedure escalona_inf (MatrizA: matriz; Vetorconst: vetor);
  52.         var i, k : integer;
  53.                 s: extended;
  54.         begin    
  55.                 for k := 1 to (N - 1) do
  56.                         begin
  57.                                 for i := (k + 1) to N do
  58.                                         begin
  59.                                                 s := MatrizA[i, k]/MatrizA[k, k];
  60.                                                 MatrizA[i, k] := 0;
  61.                                                 for j := (k + 1) to N do
  62.                                                         begin
  63.                                                                 MatrizA[i, j] := MatrizA[i, j] - s * MatrizA[k, j];
  64.                                                         end;
  65.                                                 Vetorconst[i] := Vetorconst[i] - s * Vetorconst[k];
  66.                                         end;
  67.                         end;
  68.         end;
  69.  
  70. procedure gauss (MatrizAmp: matriz; Constante: vetor);
  71.         var i, k: integer;
  72.                 Resposta: vetor;
  73.                 aux: extended;
  74.         begin
  75.                 writeln(' ');
  76.                 writeln('Gauss');
  77.                 Mauxiliar := MatrizAmp;
  78.                 Cons_auxiliar := Constante;
  79.                 escalona_inf (Mauxiliar, Cons_auxiliar);
  80.                 Resposta[N] := Cons_auxiliar[N]/Mauxiliar[N, N];
  81.                 for i := (N - 1) downto 1 do
  82.                         begin
  83.                                 aux := 0;
  84.                                 for j := (i + 1) to N do
  85.                                         begin
  86.                                                 aux := aux + Mauxiliar[i, j] * Resposta[j];
  87.                                                 Resposta[i] := (Mauxiliar[i] - aux)/Mauxiliar[i, i];
  88.                                         end;
  89.                                 for i := 1 to N do
  90.                                         begin
  91.                                                 writeln('X', i, ' = ', Resposta[i]);
  92.                                                 writeln(' ');
  93.                                         end;
  94.                         end;
  95.         end;
  96.  
  97. begin
  98.         repeat
  99.         clrscr;
  100.         write('Quantidade de vari├íveis = ');
  101.         readln(N);
  102.         for i := 1 to N do
  103.                 begin
  104.                         writeln(' ');
  105.                         writeln('Fornecer os coeficientes da equacao ', i, ':');
  106.                         for j := 1 to N do
  107.                                 begin
  108.                                         write('Coeficiente de X', j, ' = ');
  109.                                         readln(Mampliada[i,j]);
  110.                                 end;
  111.                         write('Valor da constante da equacao ', i,' = ');
  112.                         readln(Constantes[i]);
  113.         end;
  114.         writeln(' ');
  115.         writeln('Escolha o metodo de resolucao:');
  116.         writeln(' ');
  117.         writeln('1 - Eliminacao de Gauss');
  118.         writeln('2 - Metodo de eliminacao de Gauss-Jordan');
  119.         writeln('3 - Metodo de Jacobi');
  120.         writeln('4 - Metodo de Gauss-Seidel');
  121.         writeln(' ');
  122.         repeat
  123.         write(' Digite o numero do metodo escolhido (1-4): ');
  124.         readln(Num_escolha);
  125.         case num of
  126.                 1: gauss(Mampliada, Constantes);
  127.                 2: jordan(Mampliada, Constantes);
  128.                 3: jacobi(Mampliada, Constantes);
  129.                 4: seidel(Mampliada, Constantes);
  130.         end;
  131.         write('Escolher outro metodo? (S/N): ');
  132.         readln(Escolha);
  133.         Escolha := upcase(Escolha);
  134.         until Escolha = 'N';
  135.         write('Sair do programa? (S/N): ');
  136.         readln(Escolha);
  137.         resposta := upcase(Escolha);
  138.         until Escolha = 'S';
  139. end.