Método de eliminação de Gauss com pivotamento parcial

Publicado por Daniel Moreira dos Santos 25/07/2009

[ Hits: 26.475 ]

Homepage: http://www.danielmoreira.wordpress.com

Download pivoteamento.pas




Esse script executa o método de eliminação de Gauss com pivotamento parcial e dá o vetor solução X de um sistema linear da forma AX=b. O código está comentado passo a passo para ficar bem claro o que foi feito em cada passagem.

  



Esconder código-fonte

Program GaussPivot;
var
//declaração de variáveis
   i, j, k, z, n, cont, comp, c: integer;         // n é a ordem da matriz quadrada A
   A: array[1..50, 1..50] of real; // matriz A a ser usada no método de Gauss com pivoteamento parcial
        b, x: array[1..50] of real;    // vetor b do sistema linear (Ax=b)
   aux, pivo, primeiro, q, blinha: real;
begin
   writeln('Entre com a ordem da matriz A: ');
   readln(n); // armazena em n a ordem da matriz quadrada A
   
   for i:=1 to n do     // percorre as linhas
       begin
      for j:=1 to n do  //percorre as colunas
          begin
            writeln('Entre com A', i, j, ': ');
            readln(A[i,j]); // lê um elemento por vez
          end;
       end;
    
   for i:=1 to n do        // percorre as linhas do vetor b
       begin
         writeln('Entre com B', i, ': ');
         readln(b[i]);    // lê um elemento por vez
       end;

     for i:=1 to n do      // imprime a matriz A antes do processo
       begin
      for j:=1 to n do
          begin
            write(A[i,j],' ');
          end;
              writeln('');
       end;
   writeln('');
   for i:=1 to n do     // imprime o vetor b antes do processo
       begin
         writeln(b[i]);
       end;

    writeln('');
    writeln('');

      j:=1;
      while(j<n) do
       begin
          i:=1;
          while(i<=(n-j)) do
          begin
         if( abs(A[j+i,j])>abs(A[j,j]) )then   // [j,j] é a posição onde ficará o pivô, se o elemento da mesma coluna e de uma linha abaixo for maior em módulo então
           begin
                 k:=j;
                 while(k<=n) do      // troca-se a linha inteira
                begin
               aux:=A[j+i,k];   // aux: variável para auxiliar a troca dos valores poisição por posição
                 A[j+i,k]:=A[j,k];
                 A[j,k]:=aux;
                    k:=k+1; // incrementa k, k percorre as colunas de A  nas linhas envolvidas no processo de troca
                end;
                aux:=b[j+i]; // troca as linhas correspondentes no vetor b
                 b[j+i]:=b[j];
                 b[j]:=aux;
           end;

              pivo:=A[j,j]; // depois da troca temos o pivô (maior elemento) no local correto [j,j] (diagonal)
                primeiro:=A[j+i,j]; // primeiro elemento da coluna do pivô (j) e da linha i+j
          if(pivo<>0) then  // se o pivo for diferente de zero
         begin
            b[j+i]:=b[j+i] - (primeiro/pivo)*b[j]; // subtrai (fator)*b[j] do elemento de b na posição i+j
                 z:=j;
                  while(z<=n) do   // produz zeros abaixo do pivô
               begin
                A[j+i,z]:=A[j+i,z]-(primeiro/pivo)*A[j,z]; // quando z=j, A[j,j] é o pivô e então A[j+i,j]=A[j+i,j]-A[j+i,j]=0
                    z:=z+1;
               end;         
         end;
          i:=i+1;
          end;
         j:=j+1;
       end;

   for i:=1 to n do      // imprime a matriz A depois do processo terminado
       begin
      for j:=1 to n do
          begin
            write(A[i,j],' ');
          end;
              writeln('');
       end;
   writeln('');
   for i:=1 to n do     // imprime o vetor b depois do processo terminado
       begin
         writeln(b[i]);
       end;

    //calcula o vetor solução x do sistema linear Ax=b
    cont:=0; // cntará o numero de elementos (na posição pivô) nulos
    j:=n;
    if(A[j,j]<>0) then // verifica se o ultimo pivô não é nulo
    begin
       x[j]:=b[j]/A[j,j]; // calcula o ultimo elemento do vetor solução
    end
     else
     begin
         cont:=cont+1;  // conta um pivô nulo
         blinha:=b[j]; // blinha é o b[j] da linha correspondente ao pivô nulo
         for c:=1 to (n-1) do
         begin
             blinha:=blinha-(A[j,c]*x[c]);
         end;
         if(blinha=0)then   //se blinha é zero
         begin
            comp:=1;     // sistema compativel e indeterminado
         end else comp:=2;   // senão incompativel
     end;
    j:=j-1;
    while(j>=1) do   // faz o mesmo para os pivôs das outras linhas
    begin

      if(A[j,j]<>0) then
      begin
         i:=n;
         x[j]:=b[j];
         while(i>j) do
         begin
         x[j]:=x[j]-(x[i]*A[j,i]);
         i:=i-1;
         end;
         x[j]:=x[j]/A[j,j];
      end
        else
          begin
            cont:=cont+1;
            blinha:=b[j];
            for c:=1 to (n-1) do
            begin
             blinha:=blinha-(A[j,c]*x[c]);
            end;
            if(blinha=0)then
            begin
            comp:=1;
            end else comp:=2;
          end;
    j:=j-1;
    end;
if(cont=0) then
begin
    writeln('');
    writeln('X:');
    for i:=1 to n do     // imprime o vetor solução x
    begin
      writeln(x[i]);
    end;
end
 else if(comp=1)then
       begin
         writeln('Sistema compativel e indeterminado. ');
       end else
            begin
                 writeln('Sistema incompativel.');
            end;

readln(q);

end.

Scripts recomendados

Juros

Raiz

GTK em (Free)Pascal

Eleição simples

Sistemas númericos


  

Comentários

Nenhum comentário foi encontrado.


Contribuir com comentário




Patrocínio

Site hospedado pelo provedor RedeHost.
Linux banner

Destaques

Artigos

Dicas

Tópicos

Top 10 do mês

Scripts