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.

• Download pivoteamento.pas
• Enviar nova versão

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.

Calculadora

Crivo de Eratóstenes Simples em Pascal

Juros

Forca

Sistemas númericos

Nenhum comentário foi encontrado.