+ Responder ao Tópico
Resultados 1 a 2 de 2

Tópico: ajuda com program em pascal

  1. #1
    Junior Member
    Data de Ingresso
    May 2010
    Localização
    recife
    Posts
    1
    Thanks
    0
    Thanked 0 Times in 0 Posts

    ajuda com program em pascal

    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.

  2. #2
    Administrador - Fórum Avatar de LFCavalcanti
    Data de Ingresso
    Jan 2008
    Localização
    São Paulo - Brasil
    Posts
    1,995
    Thanks
    16
    Thanked 11 Times in 11 Posts
    Seja Bem-Vinda Amanda.
    O Código realmente está grande... hehe
    Mas por favor, nos explique qual exatamente a sua dificuldade e se possivel poste um arquivo de texto ou o próprio do compilador para podermos visualizar a edentação.
    Atenciosamente,
    Luiz Fernando Cavalcanti
    Gestor e Consultor em TIC


    "
    A revolução da informação representa um nítida transferência de poder de quem detém o capital para quem detém o conhecimento." - Peter Drucker

+ Responder ao Tópico

Tópicos Similares

  1. Ajuda com programa em pascal
    Por REI no fórum Desenvolvimento de Sistemas
    Respostas: 1
    Último Post: 11-26-2009, 05:04 PM
  2. Exercícios Algoritmo/Pascal
    Por Kaki no fórum Desenvolvimento de Sistemas
    Respostas: 8
    Último Post: 11-06-2009, 06:19 AM
  3. Programa com Interface bem trabalhada em Pascal
    Por illo no fórum Desenvolvimento de Sistemas
    Respostas: 7
    Último Post: 09-10-2009, 01:21 PM
  4. PASCAL - Interface gráfica e BD?
    Por mag00 no fórum Desenvolvimento de Sistemas
    Respostas: 4
    Último Post: 06-26-2008, 09:09 PM
  5. Arquivos de Programas virou Program Files
    Por StriKer_CSS no fórum Windows
    Respostas: 1
    Último Post: 04-27-2008, 09:23 PM

Visitantes acharam esta pagina procurando por:

algoritmo gauss seidel pascalmetodo gauss pascalprograma eliminação de Gauss pascalprograma feito em pascal do metodo de gauss e gauss-jacobieliminação de gauss em pascalfazer um programa em pascal usando o método de Gaussalgoritmo Gauss-seidelalgoritmo pascal Gauss Jacobialgoritmo para o método de gauss-seidel em pascalgauss com pivoteamento em Pascaleliminacion de gauss jordan pascalalgoritmo gauss-jacobiexemplo de downto pascalfor k:=1 to i - 1 do pascalpascal procedimento definir ordem matrizfonte gauss jacobi pascalalgoritimo para resolver metodo de gauss pascalprograma pascal RESOLVER ERROcodigo algoritmo feito de gauss jacobialgoritmo para compilação de metodo de jacobiprograma em pascalpara resolver sistemas linearessair do programa pascalprograma pascal gauss seidelprogramas sistemas não lineares em pascalpascal array downtocont pascalcomo meto horas atuais em pascalgauss seidel pascalgauss jordan pascalpivotamento em pascal
SEO Blog

Permissões de Postagem

  • Você não pode iniciar novos tópicos
  • Você não pode enviar respostas
  • Você não pode enviar anexos
  • Você não pode editar suas mensagens