Bagi yang mempunyai kesulitan dalam praktikum mata kuliah Metode numerik,....tidak ada salahnya kita belajar dari listing program pascal nya yang sudah jadi..., nie adalah hasil praktikum saya selama 1 semester..... silahkan d jajal neh.....
Listing Program Mencari akar dengan Metode Regular Falsi
program Regular_Falsi;
Uses wincrt;
label
ulang;
var
a,b,ya,yb,eps,c,yc : real;
i : integer;
g, akar: char ;
function fx (x:real) : real;
begin
fx:=(x*x)+2*x-24;
end;
procedure input_selang;
begin
write('batas bawah selang = ');readln(a);
write('batas atas selang = ');readln(b);
ya:=fx(a);
yb:=fx(b);
if (ya*yb)>0 then writeln('tidak ada akar');
end;
begin
ulang:
writeln('mencari akar persamaan dengan metode Regular Falsi');
writeln;
repeat;
input_selang;
until(ya*yb)<0; ketelitian =" ');">
METODE SECANT
Program Metode_Secant;
Uses Wincrt;
Var
m,i:integer;
x0,x1,y0,y1,y2,x2,eps,tol:real;
function f(x:real):real;
Begin
f:=sqr(x)+3*x-4;
End;
Begin
Writeln(' Metode Secant');
Writeln;
Write(' Masukkan nilai x0: ');Readln(x0);
Write(' Masukkan nilai x1: ');Readln(x1);
Write(' Toleransi : ');Readln(tol);
Write(' Maksimum Iterasi : ');Readln(m);
Writeln;
i:=0;
eps:=tol+1;
Writeln('-------------------------------------');
Writeln('No x0 f(x0) eps');
Writeln('-------------------------------------');
While (i<=m) and (eps>tol) do
Begin
i:=i+1;
x2:=x1-((f(x1)*(x1-x0)/(f(x1)-f(x0))));
eps:=abs((x2-x1)/x2);
x0:=x1;
x1:=x2;
Writeln(i,x2:12:6,f(x2):12:6,eps:12:6);
End;
Writeln('-------------------------------');
if (i<=m) then
Writeln('Akar persamaan : ',x2:3:6)
Else
Writeln('Toleransi ',tol:3:6,' tidak terpenuhi');
Writeln('-------------------------------');
End.
Listing Program Interpolasi Dengan Metoda Beda Terbagi Newton
Program Beda_bagi_indra;
uses wincrt;
var
i,n:integer;
x,y:array[0..20] of real;
xp,p:real;
function del(i,k:integer):real;
begin
if(k-i<=0) then del:=y[i]
else if(k-i=1) then del:=(y[k]-y[i])/(x[k]-x[i])
else del:=(del(i+1,k)-del(i,k-1))/(x[k]-x[i]);
end;
function Newton(xp:real):real;
var
interpolasi,faktor:real;
i,j:integer;
begin
interpolasi:=y[0];
for i:=1 to n-1 do
begin
faktor:=1;
for j:=0 to i-1 do
faktor:=faktor*(xp-x[j]);
interpolasi:=interpolasi+del(0,i)*faktor;
end;
Newton:=interpolasi;
end;
begin
writeln(' Interpolasi Beda Terbagi Newton');
writeln;
write(' Jumlah data n = ');readln(n);
for i:=0 to n-1 do
begin
writeln;
write(' input data x[',i:1,'] = ');readln(x[i]);
write(' input data f(x)[',i:1,'] = ');readln(y[i]);
end;
writeln;
write(' input x = ');readln(xp);
p:=Newton(xp);
write(' hasil perhitungan f(x) = ',p:3:3);
end.
Listing Program Interpolasi Dengan Metoda Lagrange
program lagrange_Indra;
uses wincrt;
var
i,n: integer;
x,y:array[0..20] of real;
x_int,hasil:real;
function lagrange(x_int:real):real;
var
p_lag,faktor:real;
i,j:integer;
begin
p_lag:=0;
for j:=0 to n-1 do
begin
faktor:=y[i];
for j:=0 to n-1 do
if(i<>j) then faktor:=faktor*(x_int-x[j])/(x[i]-x[j]);
p_lag:=p_lag+faktor;
end;
lagrange:=p_lag;
end;
begin
writeln(' Program Interpolasi Lagrange ');
writeln;
write(' Jumlah data n = ');readln(n);
writeln;
for i:=0 to n-1 do
begin
write(' Input Data x[',i:1,'] = ');readln(x[i]);
write(' Input Data,f(x)[',i:1,'] = ');readln(y[i]);
end;
writeln;
write(' Input x = ');readln(x_int);
hasil:=lagrange(x_int);
writeln(' Hasil Perhitungan f(x) = ',hasil:3:3);
end.
Metode Bisection
Program bisection;
Uses wincrt;
Var
a,b,ya,yb,eps,x0,y0 : real;
l : integer;
function fx (x:real):real;
begin
fx:=sqr(x)+6*(x)+2;
end;
procedure input_selang;
begin
write('batas bawah selang = ') ; readln(a);
write('batas atas selang = ') ; readln(b);
ya:=fx(a);
yb:=fx(b);
if(ya*yb)=0 then
writeln('tidak ada akar pada selang ini');
end;
begin
writeln('mencari akar dengan metode bisection');
writeln;
repeat;
input_selang;
until (ya*yb)<0;
write('ketelitian = ' );readln(eps);
clrscr;
l:=0;
writeln('-----------------------------------');
writeln('no x f(x) error)');
writeln('-----------------------------------');
repeat;
l:=l+1;
x0:=(a+b)/2;
y0:=fx(x0);
writeln(l, x0 :13:5,y0:14:5,abs(b-a):15:5);
if(ya*y0)<0then
b:=x0;
a:=a;
begin
a:=0;
b:=b;
end;
until abs (b-a)
writeln('-----------------------------------');
writeln('akar = ',x0:5:3);
writeln('error = ',abs(b-a):5:3);
end.;
end.
Program Metode_tabulasi;
uses wincrt;
var
a,b,x,y,l:real;
j,k,n,i:integer;
g :char;
c,d :array[byte] of real;
function fx (x:real):real;
begin
fx:=sqr(x)-(x)+3;
end;
begin
clrscr;
writeln('Program Tabulasi');
writeln('Mencari Selang Akar Pada interval [x,y]');
writeln;
write('Masukkan nilai x= ');readln (a);
write('masukkan nilai y= ');readln (b);
x:=a;y:=b;
write('interval setiap selang: ');readln(l);
writeln('-----------------------------------------------');
writeln(' x f(x) ');
writeln('-----------------------------------------------');
if b
begin
a:=x; b:=y;
end;
j:=0;
while a
begin
j:=j+1;
c[j]:=a;
d[j]:=fx(a);
writeln (c[j]:18:3,d[j]:20:3);
a:=a+l;
end;
g:='a'; n:=0;
writeln('------------------------------------------------');
if (d[j]=0) then
begin
writeln('akar=',c[j]:2:3);
g:='b';
end;
for k:=2 to i do
begin
if (d[k]>0)and(d[k-1]<0)then
begin
if n=0 then
writeln('ada akar pada interval');
n:=1;
g:='b';
writeln('akar terletak pada[',c[k-1]:3:3,',',c[k]:3:3,']');
end
else if(d[k]<0)>0) then
begin
if n=0 then
n:=1;
writeln('akar terletak pada [',c[k-1]:3:3,',',c[k]:3:3,']');
g:='b';
writeln('------------------------------------------------');
end
else if(k=i)and(g='a')then
writeln('tidak ada akar pada [',x:3:3,',',y:3:3,']');
end;
end.
Listing Program Untuk Menyelesaikan Suatu Nilai awal dari Persamaan Diferensial Biasa Dengan Metode Euler
Program metode_euler;
Uses wincrt;
Var t0,y0,h,x,m,hasil : real;
n : integer;
function dif_f(y,t : real):real;
begin
dif_f := (y-t)/(y+t);
end;
procedure euler(y0,t0,h,x : real; n : integer; var hasil : real);
var
i : integer;
y,t : real;
begin
y := y0;
t := t0 ;
writeln(0,t:15:6,y:15:6);
for i := 1 to n do
begin
y := y+h*dif_f(y,t);
t := t+h;
writeln(i,t:15:6,y:15:6);
end;
hasil := y
end;
begin
write('Perhitungan MNA da suatu PDB dengan metode Euler');
write('Masukkan nilai t awal : ');readln(t0);
write('Masukkan nilai y awal : ');readln(y0);
write('Masukkan nilai t yang akan dicari y(t) nya : ');readln(x);
write('Masukkan ukuran langkah : ');readln(h);
m := (x-t0)/h;
while frac(m) <> 0 do
begin
writeln('Ukuran langkah tidak sesuai');
write('Masukkan ukuran langkah : ');readln(h);
m := (x-t0)/h;
end;
n := round(m);
writeln('=====================================');
writeln(' i t y(t) ');
writeln('-------------------------------------');
euler(y0,t0,h,x,n,hasil);
writeln('-------------------------------------');
writeln('Nilai y(t) nya adalah : ',hasil:5:6);
end.
Listing Program Untuk Menyelesaikan Suatu Nilai awal dari Persamaan Diferensial Biasa Dengan Metode Runge-Kutta Orde 4
program rungge_kutta;
uses wincrt;
var
t0,y0,m,x,h,hasil:real; n: integer;
function dif_f(y,t:real):real;
begin
dif_f:=(y+t);
end;
procedure runggekutta(yo,t0,h,x:real ;n : integer; var hasil:real);
var i : integer; y,t, k1,k2,k3,k4: real;
begin
y:=yo;
t:=t0;
writeln;
for i:= 1 to n do
begin
k1:=h*dif_f(y,t);
k2:=h*dif_f(y+k1/2,t+h/2);
k3:=h*dif_f(y+k2/2,t+h/2);
k4:=h*dif_f(y+k3,t+h)/6;
y:= y+(k1+(2*k2)+(2*k3)+k4)*(h/6);
t:=t+h;
writeln(i, t:16:6, y:16:6);
end;
hasil:=y;
end;
begin
writeln(' perhitungan rungge kutta ');
write('masukan nilai t awal :'); readln(t0);
write('masukan nilai y awal :'); readln(y0);
write('masukan nilai t yang dicari y(t):'); readln(x);
write('masukan ukuran langkah :'); readln(h);
m:=(x-t0)/h;
while frac(m)<>0 do
begin
writeln('ukuran tidak sesuai!');
write('masukan ukuran langkah :'); readln(h);
m:=(x-t0)/h;
end;
n:=round(m);
writeln('---------------------------------------');
writeln('| i t y(t) |');
writeln('----------------------------------------');
runggekutta(y0,t0,h,x,n,hasil);
writeln;
writeln('----------------------------------------');
writeln('nilai y(t) nyaadalah :',hasil :5:3);
end.
Listing Program Menghitung Integral Menggunakan Metode Trapesium
Program Trapesium;
Uses wincrt;
Var
a,b,itg,h,x,y,hasil:real;
i,n,w:integer;
function f(x:real):real;
Begin
f:=sqr(x)+2; ne soal. . . ..
End;
Begin
writeln(' Perhitungan Integral Dengan Metode Trapesium');
writeln;
write(' Masukkan batas bawah : ');readln(a);
write(' Masukkan batas atas : ');readln(b);
write(' Banyak interval : ');readln(n);
writeln;
writeln(' =========================================');
writeln(' i x f(x) ');
writeln(' =========================================');
h:=(b-a)/n; ne rumus cari nilai h . . .
itg:=0;
for i:=0 to n do var proses looping . . .
Begin
x:=a+i*h; rumus cari nilai x . . .
y:=f(x);
writeln(i:1,x:20:3,y:15:3);
w:=2;
if(i=0) or (i=n) then w:=1;
itg:=itg+w*y; ne rumus cari integral . . .
end;
Hasil:=itg*h/2; rumus cari hasil akhir . . .
writeln(' =========================================');
writeln;
writeln(' Hasil Integrasinya : ',hasil:5:3);
End.
Listing Program Menghitung Integral Menggunakan Metode Simpson 1/3
Program Simpson13;
Uses wincrt;
Var
a,b,itg,h,x,y,hasil:real;
i,n,w:integer;
function f(x:real):real;
Begin
f:=sqr(x)+2*x;
End;
Begin
writeln(' Perhitungan Intesral Dengan Metode Simpson 1/3');
writeln;
write(' Masukkan batas bawah : ');readln(a);
write(' Masukkan batas atas : ');readln(b);
write(' Banyak interval : ');readln(n);
writeln;
if (n mod 2 =1) then write(' Perhatian !!!!! n harus genap') else
begin
writeln;
writeln(' =========================================');
writeln(' i x f(x) ');
writeln(' =========================================');
h:=(b-a)/n;
itg:=0;
for i:=0 to n do
Begin
x:=a+i*h;
y:=f(x);
writeln(i,x:20:3,y:15:3);
w:=2;
if(i=0) or (i=n) then w:=1;
itg:=itg+w*y;
end;
Hasil:=itg*h/3;
writeln(' =========================================');
writeln;
writeln(' Hasil Integrasinya : ',hasil:5:3);
End;
End.
Listing Program Mencari akar dengan Metode Regular Falsi
0 comments:
Post a Comment