Universidad Tecnologica De México (Campus Sur)

Merino Vallecillo Romulo 9945830-7

Mètodos Numèricos 3r. Cuatrimestre

Programa:

Integraciòn Numèrica

Mètodo De Simpson

Program Simpson (Input,Output);

Uses Crt;

Const V=20;

Type

Arreglo=Array [0..V] Of Real;

Arreglo1=Array [0..V] Of Real;

Var

R,N,I,J:Integer;

Fx,Ysump,Ysumn,H:Real;

X:Arreglo;

Y:Arreglo;

Procedure Par;

Begin

Ysumn:=0;

Ysump:=0;

R:=1;

Repeat

Ysumn:=Ysumn+Y[R];

R:=R+2;

Until R=N;

R:=2;

Repeat

Ysump:=Ysump+Y[R];

R:=R+2;

Until R=N-1;

Write('Introduzca El Intervalo Entre Valores: ');

Readln (H);

Fx:=(H/3)*(Y[0]+Y[N-1]+(4*Ysumn)+(2*Ysump));

Writeln;

Writeln(' "Soluciòn" ');

Write('La Integral De La Funciòn F(X) De La Tabla Es: ',Fx:6:3);

Readln;

End;

Begin

Clrscr;

Write('Nùmero De Pares De Valores En X,Y: ');

Readln (N);

Writeln;

For I:=0 To N-1 Do

Begin

Gotoxy (3,I+2);

Write ('X[',I,']= ');

Readln (X[I]);

Gotoxy (15,I+2);

Write ('Y[',I,']: ');

Readln (Y[I]);

End;

Writeln;

Par;

End.

UNIVERSIDAD TECNOLOGICA DE MÉXICO (Campus Sur)

MERINO VALLECILLO ROMULO 9945830-7

MÈTODOS NUMÈRICOS 3r. CUATRIMESTRE

PROGRAMA:

MÌNIMOS CUADRADOS

Program MÌNIMOS_CUADRADOS;

Uses crt;

Const

max = 31;

Type

arreglo = array [1..max] of real;

Var

op:char;

x,y,xy,xx:arreglo;

i,j:integer;

sum,sum2,sum3,sum4,m,b:real;

Begin

Repeat

clrscr;

write('Introduce el valor de i: ');

read(i);

writeln;

sum:=0;

for j:=1 to i do

begin

write('Introduce el valor de X',j,': ');

readln(x[j]);

sum:=sum+x[j];

end;

x[i+1]:=sum;

sum2:=0;

writeln;

for j:=1 to i do

Begin

write('Dame el valor de Y',j,': ');

readln(y[j]);

sum2:=sum2+y[j];

end;

y[i+1]:=sum2;

sum3:=0;

for j:=1 to i do

Begin

xx[j]:=(x[j])*(x[j]);

sum3:=sum3+xx[j];

end;

xx[i+1]:=sum3;

sum4:=0;

for j:=1 to i do

Begin

xy[j]:=x[j]*y[j];

sum4:=sum4+xy[j];

end;

xy[i+1]:=sum4;

m:=((i*xy[i+1])-(x[i+1]*y[i+1]))/((i*xx[i+1])-(sqr(x[i+1])));

b:=((xx[i+1]*y[i+1])-(xy[i+1]*x[i+1]))/((i*xx[i+1])-(sqr(x[i+1])));

writeln;

for j:=1 to i+1 do

writeln(j,' ',x[j]:8:3,' ',y[j]:8:3,' ',xy[j]:8:3,' ',xx[j]:8:3);

Readln;

write('El valor de "m" es: ',m:8:3);

writeln;

write('El valor de "b" es: ',b:8:3);

Readln;

writeln;

write('¨Quiere hacerlo de nuevo?: ');

readln(op);

op:=upcase(op)

until op<>'S';

end.

UNIVERSIDAD TECNOLOGICA DE MÉXICO (Campus Sur)

MERINO VALLECILLO ROMULO 9945830-7

MÈTODOS NUMÈRICOS 3r. CUATRIMESTRE

PROGRAMA:

MATRICES (GAUSS)

Program gauss;

uses crt;

type Matriz=array[1..10,1..11] of real;

Vector=array[1..11] of real;

label salida,salida1;

var A:Matriz;

x:Vector;

n,i:integer;

res:real;

dc:char;

procedure leer(var A:Matriz; n:integer);

Var i,j:integer;

begin

Clrscr;

writeln('Escribe los datos de la matriz A de ',n,'*',n);

for i:=1 to n do

begin

for j:=1 to n do

begin

gotoxy(2+(2*j),i+i); readln(A[i,j]);

end;

end;

end;

procedure leervec(var A:Matriz; n:integer);

var i:integer;

begin

clrscr;

For i:=1 to n do

begin

writeln('Escribe el dato b(',i,')');

readln(A[i,n+1])

end;

end;

procedure escribir(var A:Matriz; n:integer);

var i,j:integer;

begin

clrscr;

for i:=1 to n do

begin

For j:=1 to n+1 do

begin

gotoxy(j+2+(10*j),i+i); write(A[i,j]:10:4);

End;

End;

end;

Procedure Gaussito(var A:Matriz; var res:real; x:vector; n:integer);

Var i,j,k:integer;

m,sum:real;

begin {1}

for i:=1 to N-1 do

begin {2}

if (A[i,i]=0) then

begin {3}

k:=1;

repeat

k:=k+1;

until (A[k,i]<>0) or (k=n);

res:=1.0;

if (i=N) and (A[k,i]=0) then

begin{4}

res:=2.0;

end{4}

else

begin

x[j]:=A[i,j];

A[i,j]:=A[k,j];

A[k,j]:=x[j];

end;

end;{3}

end;{2}

for j:=i+1 to n do

begin

m:=A[j,i]/A[i,i];

for k:=1 to n+1 do

begin

A[j,k]:=A[j,k]-m*A[i,k];

end;

end;

if (A[n,n]=0) then

begin

res:=2.0 ;

end

else

begin

x[n]:=A[n,n+1]/A[n,n];

for i:=n-1 downto 1 do

begin

sum:=0;

for j:=i to n do

begin

sum:=sum+A[i,j]*X[j];

x[i]:=A[i, n+1]-sum/A[1,1];

end;

end;

end;

end{1};

begin {principal}

clrscr;

write ('ESTE PROGRAMA RESUELVE SISTEMAS DE N ECUACIONES');

WRITE(' LINEALES CON N Incógnitas');

WRITELN;

repeat

WRITE('ESCRIBA EL número DE ECUACIONES: ' );

READLN(n);

leer(A,n);

leervec(A,n);

escribir(A,n);

gotoxy(20,12); write('¿LOS DATOS INTRODUCIDOS

SON CORRECTOS? (S/N) : ');

READLN(dc);

until(dc<>'n');

Gaussito(A,res,x,n);

if (res=2) then

begin

WRITE('EL SISTEMA NO TIENE Solución');

end

else

begin

escribir(A,n);

for i:=1 to n do

begin

gotoxy(20,10+i); write('Esta es la solución X',i,'=',x[i]);

end;

end;

readln;

end.

Universidad Tecnologica De México (Campus Sur)

Merino Vallecillo Romulo 9945830-7

Mètodos Numèricos 3r. Cuatrimestre

Programa:

POLINOMIO DE LAGRANGE

PROGRAM LAGRANGE;

USES wincrt;

CONST v=10;

TYPE

ARREGLO = ARRAY [1..v] OF REAL;

ARREGLO1 = ARRAY [1..V]OF REAL;

VAR

N,I,J: INTEGER;

Xx, Yx, PNUM, PDEM: REAL;

X: ARREGLO;

Y: ARREGLO1 ;

BEGIN

CLRSCR;

WRITELN ('NUMERO DE PARES DE X,Y, ');

READLN (N);

FOR I:=1 TO N DO;

BEGIN

GOTOXY(3,i+2);

WRITE ('X(',I,')=');

READLN (Y[I]);

END;

WRITELN;

WRITE ('vALOR DE X?');

READLN (Xx);

Yx:=0;

FOR I:=1 TO N DO;

BEGIN

PNUM:=1;

PDEM:=1;

FOR J:=1 TO N DO

BEGIN

IF J<>I THEN

BEGIN

PNUM:= PNUM*(Xx-X[J]);

PDEM:= PDEM*(X[I]-X[I]);

END;

END;

YX:= Yx+((PNUM/PDEM)*Y[I]);

END;

WRITELN;

WRITELN('EL VALOR DE Y CORRESPONDIENTE ES ' ,Yx:6:3);

READLN

END.